packages feed

darcs 2.2.1 → 2.3.0

raw patch · 210 files changed

+9774/−6183 lines, 210 filesdep +HUnitdep +QuickCheckdep +hashed-storagedep ~HTTPdep ~basedep ~haskelinesetup-changednew-component:exe:unitnew-component:exe:witnessesbinary-added

Dependencies added: HUnit, QuickCheck, hashed-storage, mmap, test-framework, test-framework-hunit, test-framework-quickcheck2, utf8-string

Dependency ranges changed: HTTP, base, haskeline, mtl, parsec, regex-compat, terminfo, unix, zlib

Files

Distribution/ShellHarness.hs view
@@ -6,10 +6,10 @@                           Permissions(..), getDirectoryContents,                           findExecutable, createDirectoryIfMissing ) import System.Environment ( getEnv, getEnvironment )-import System.Exit ( ExitCode (..), exitWith )+import System.Exit ( ExitCode (..) ) import System.FilePath import System.IO-import System.Process ( ProcessHandle, runInteractiveCommand,+import System.Process ( ProcessHandle,                         runInteractiveProcess, waitForProcess,                         getProcessExitCode ) import Data.Maybe@@ -22,9 +22,9 @@ #endif import Control.Monad -runTests :: String -> [String] -> IO Bool-runTests cwd tests = do-     fails <- run tests+runTests :: Maybe FilePath -> String -> [String] -> IO Bool+runTests darcs_path cwd tests = do+     fails <- run darcs_path tests      if  "bugs" `isInfixOf` cwd          then if (length tests /= length fails)                  then do putStrLn $ "Some bug tests passed:"@@ -39,15 +39,17 @@                  else do putStrLn "All tests OK"                          return True -run :: [String] -> IO [String]-run tests= do+run :: Maybe FilePath -> [String] -> IO [String]+run set_darcs_path tests= do     cwd <-  getCurrentDirectory     path <- getEnv "PATH"     env <- getEnvironment-    darcs_path <- get_darcs_path+    darcs_path <- case set_darcs_path of+                    Nothing -> get_darcs_path+                    Just x -> return x     let myenv = [("HOME",cwd)-                ,("DARCS_TESTING_HOME",cwd)-                ,("PWD",cwd)+                ,("TESTS_WD",cwd)+                ,("DARCS_TESTING_PREFS_DIR",cwd </> ".darcs")                 ,("EMAIL","tester")                 ,("DARCSEMAIL","tester")                 ,("PATH",(darcs_path++":"++path))@@ -84,7 +86,7 @@                        run_helper shell ts (fails++[test]) env   where cleanup_dirs :: IO ()         cleanup_dirs =-          do dirfiles <- getDirectoryContents (fromJust $ lookup "PWD" env)+          do dirfiles <- getDirectoryContents (fromJust $ lookup "TESTS_WD" env)              let tempfiles = (filter ("temp" `isPrefixOf`) dirfiles) ++                              (filter ("tmp" `isPrefixOf`) dirfiles)              mapM_ (\x-> @@ -101,7 +103,7 @@    (exitcode,res) <- backtick_helper cmd args env    case exitcode of         ExitSuccess -> return (res, True)-        ExitFailure code -> return (res, False)+        ExitFailure _ -> return (res, False)  backtick_helper :: String -> String -> [(String,String)] ->                                       IO (ExitCode, String)@@ -110,6 +112,7 @@                                                    (Just env)                                                ) "" +find_bash :: IO FilePath find_bash =    do sh <- findExecutable "bash"       case sh of
+ NEWS view
@@ -0,0 +1,2321 @@+Darcs 2.3.0, 23 Jul 2009++ * Important changes in Darcs 2.3.0++   * Lots and lots of documentation changes (Trent).+   * Haskeline improvements (Judah).+   * Cabal as default buildsystem (many contributors).+   * Fixes in darcs check/repair memory usage (Bertram, David).+   * Performance improvement in subtree record (Reinier).+   * New option: --summary --xml (Florian Gilcher).+   * New option: changes --max-count (Eric and Petr).+   * Fix changes --only-to-files for renames (Dmitry).+   * Performance fix in "darcs changes" (Benedikt).+   * Hardlinks on NTFS (Salvatore).+   * Coalesce more changes when creating rollbacks (David).+   * New unit test runner (Reinier).+   * Inclusion of darcs-shell in contrib (László, Trent).+   * Author name/address canonisation: .authorspellings (Simon).+   * Working directory index and substantial "darcs wh" optimisation (Petr).+   * New command: "darcs show index" (Petr).+   * Gzip CRC check and repair feature (Ganesh).++ * Bugs Fixed in Darcs 2.3.0++   See http://bugs.darcs.net/issueN for details on bug number N.++   *  948 darcsman (Trent)+   * 1206 countable nouns (Trent)+   * 1285 cabal test v. cabal clean (Trent)+   * 1302 use resolved, not resolved-in-unstable (Trent)+   * 1235 obliterate --summary (Rob)+   * 1270 no MOTD for --xml-output (Lele)+   * 1311 cover more timezones (Dave)+   * 1292 re-encoding haskeline input (Judah)+   * 1313 clickable ToC and refs in PDF manual Trent)+   * 1310 create merged \darcsCommand{add} (Trent)+   * 1333 better "cannot push to current repository" warning (Petr)+   * 1347 (autoconf) check for unsafeMMapFile if mmap use enabled (Dave)+   * 1361 specify required includes for curl in cabal file (Reinier)+   * 1379 remove libwww support (Trent)+   * 1366 remove unreachable code for direct ncurses use (Trent)+   * 1271 do not install two copies of darcs.pdf (Trent)+   * 1358 encode non-ASCII characters in mail headers (Reinier)+   * 1393 swap "darcs mv" and "darcs move" (Trent)+   * 1405 improve discoverability of global author file (Trent)+   * 1402 don't "phone home" about bugs (Trent)+   * 1301 remove obsolete zsh completion scripts (Trent)+   * 1162 makeAbsolute is now a total function (Ben F)+   * 1269 setpref predist - exitcode ignored bug (Ben M)+   * 1415 --edit-long-comment, not --edit-description, in help (Trent)+   * 1413 remove duplicate documentation (Trent)+   * 1423 complain about empty add/remove (Trent)+   * 1437 Implement darcs changes --max-count (Eric)+   * 1430 lazy pattern matching in (-:-) from Changes command module (Dmitry)+   * 1434 refactor example test (Trent)+   * 1432 refer to %APPDATA%, not %USERPROFILE% (Trent)+   * 1186 give a chance to abort if user did not edit description file (Dmitry)+   * 1446 make amend-record -m foo replace only the patch name (Dmitry)+   * 1435 default to get --hashed from a darcs-1.0 source (Trent)+   * 1312 update and reduce build notes (Trent)+   * 1351 fix repository path handling on Windows (Salvatore)+   * 1173 support hard links on NTFS (Salvatore)+   * 1248 support compressed inventories for darcs-1 repos (Ganesh)+   * 1455 implement "darcs help environment" (Trent)+++Darcs 2.2.0, 16 Jan 2009++ * Important changes in Darcs 2.2.0++   * Support for GHC 6.10.+   * Improved Windows support.+   * Cabal is now supported as a build method for darcs.+   * Low-level optimisations in filesystem code.+   * Overhaul of the make-based build system.+   * Extensive manual and online help improvements.+   * Improved API documentation (haddock) for existing darcs modules.+   * Improvements in the testing infrastructure.+   * Improved performance for "darcs repair".+   * Improved robustness for "darcs check".+   * Numerous major and minor bug fixes, refactorings and cleanups.+   * When recording interactively it is now possible to list all+     currently selected hunks (command 'l').++   * It is now possible to specify --in-reply-to when using darcs send,+     to generate correct references in the mail header.++   * Repositories can no longer be created with --no-pristine-tree.+     This only affects the legacy darcs-1 repository format.++   * Experimental Darcs library, providing increase flexibility and+     efficiency to third-party utilities (compared to the command-line+     interface).  Only built via Cabal.  NOT a stable API yet.++ * Bugs Fixed in Darcs 2.2.0++   See http://bugs.darcs.net/issueN for details on bug number N.++   *  525 amend-record => darcs patches show duplicate additions+   *  971 darcs check fails (case sensitivity on filenames)+   * 1006 darcs check and repair do not look for adds+   * 1043 pull => mergeAfterConflicting failed in geteff (2.0.2+)+   * 1101 darcs send --cc recipient not included in success message+   * 1117 Whatsnew should warn on non-recorded files+   * 1144 Add darcs send --in-reply-to or --header "In-Reply-To:...+   * 1165 get should print last gotten tag+   * 1196 Asking for changes in /. of directory that doesn't exist...+   * 1198 Reproducible "mergeConflictingNons failed in geteff with ix"+   * 1199 Backup files darcs added after external merge+   * 1223 sporadic init.sh test failure (2.1.1rc2+472)+   * 1238 wish: darcs help setpref should list all prefs+   * 1247 make TAGS is broken+   * 1249 2.1.2 (+ 342 patches) local drive detection on Windows error+   * 1272 amend-record not the same as unrecord + record+   * 1273 renameFile: does not exist (No such file or directory)+   * 1223 sporadic init.sh test failure (2.1.1rc2+472)+++darcs (2.1.2)++ * Quality Assurance: Disable a new test that was not yet working+   under Windows++ -- Eric Kow <kowey@darcs.net>  Mon, 10 Nov 2008 10:40:00 GMT++darcs (2.1.1)++ -- Eric Kow <kowey@darcs.net>  Mon, 10 Nov 2008 08:18:00 GMT++darcs (2.1.1rc2)++  * Portability: Removed accidental QuickCheck 2.1 configure check.+    Note that it may be required in a future version of darcs.++ -- Eric Kow <kowey@darcs.net>  Mon, 10 Nov 2008 11:17:00 GMT++darcs (2.1.1rc1)++  * Portability: GHC 6.10.1 support (Petr Ročkai, Eric Kow)++  * Bug Fix: Fix file handle leak and check for exceptions on process+    running on Windows (issue784, Salvatore Insalaco)++  * Quality Assurance: Consolidated regression test suites using+    shell scripts only (Eric Kow, Tommy Petterson, Matthias Kilian)++ -- Eric Kow <kowey@darcs.net>  Mon, 10 Nov 2008 09:49:00 GMT++darcs (2.1.0)++  * Bug Fix: Eliminate a 'same URLs with different parameters' error when+    fetching files over HTTP (issue1131, Dmitry Kurochkin)++  * User Experience: Corrections to the default boring file (Ben Franksen)++  * Bug Fix: Fix the %a option in darcs send --sendmail-command (Ben Franksen)++  * Bug Fix: Do not obscure the SSH prompts or text editor output with+    progress reporting (issue1104, issue1109, Dmitry Kurochkin, David Roundy)++  * Bug Fix: pull --intersection work now works as advertised (Tommy+    Pettersson)++ -- Eric Kow <E.Y.Kow@brighton.ac.uk>  Sun, 09 Oct 2008 12:05:32 GMT++darcs (2.1.0pre3)++  * Bug Fix: Eliminate an error merging repeated conflicts in darcs-2+    repositories (issue1043, David Roundy)++  * New Feature: Hide 'Ignore-this:' lines which will be generated by future+    versions of darcs to prevent patch-id collisions. (issue1102, Eric Kow,+    David Roundy)++  * Bug Fix: Support darcs repositories which have symbolic links in their+    paths (issue1078, Dmitry Kurochkin)++  * Bug Fix: Make ssh connection sharing (darcs transfer-mode) work with+    old-fashioned repositories (issue1003, David Roundy)++ -- Eric Kow <E.Y.Kow@brighton.ac.uk>  Sun, 02 Oct 2008 09:12:41 GMT++darcs (2.1.0pre2)++  * IMPORTANT: Create darcs-2 repositories by default in darcs init (issue806,+    David Roundy)++  * User Experience: Do not allow users to add files to a darcs repository if+    their filenames would be considered invalid under Windows. This can be+    overridden with the --reserved-ok flag (issue53, Eric Kow)++  * Bug Fix: Do not leave behind a half-gotten directory if darcs get fails+    (issue1041, Vlad Dogaru, David Roundy)++  * User Experience: notice when you are trying to pull from a seemingly+    unrelated repository, that is one with a sufficiently different history.+    This can be overridden with the --allow-unrelated-repos flag (Dmitry+    Kurochkin, David Roundy)++  * Bug Fix: Fix hang after a user input error (for example, EOF) (Judah+    Jacobson)++  * Quality Assurance: Improvements to documentation and online help (Simon+    Michael)++ -- Eric Kow <E.Y.Kow@brighton.ac.uk>  Sun, 25 Sep 2008 08:10:49 GMT++darcs (2.0.3pre1)++  * New Feature: Optional readline-like functionality when compiled with the+    haskeline package (Judah Jacobson, Gaëtan Lehmann)++  * Bug Fix: No more spurious pending patches (issue709, issue1012, David+    Roundy)++  * Bug Fix: darcs get --to-match now works with hashed repositories+    (issue885, David Roundy)++  * User Experience: Catch mistakes in _darcs/prefs/defaults (issue691, Dmitry+    Kurochkin)++  * User Experience: Improved support for darcs send over http (see also+    tools/upload.cgi) (Dmitry Kurochkin, David Roundy)++  * Bug Fix: Recognize user@example.com: as an ssh path, that is, not+    requiring a path after the server component. (David Roundy)++  * New Feature: Accept an optional directory argument in darcs send+    --output-auto-name (Dmitry Kurochkin)++  * User Experience: New --no-cache option to help debug network issues+    (issue1054, Dmitry Kurochkin)++  * Performance: New --http-pipelining and --no-http-pipelining flags. Passing+    --http-pipelining to darcs can make darcs get and pull faster over HTTP.+    Due to a libcurl bug, this is not the default option unless darcs is+    compiled with libcurl 7.19.1, due 2008-11. (Dmitry Kurochkin)++  * Bug Fix: Eliminate hanging and crashes while fetching files over HTTP+    (issue920, issue977, issue996, issue1037, Dmitry Kurochkin)++  * Security: Fix some insecure uses of printfs in darcs.cgi (Steve Cotton)++  * Bug Fix: Handle filepaths in a simpler and more robust fashion. This fixes+    relative filepaths and recognition of symbolic links and avoids possible+    future bugs (issue950, issue1057, David Roundy, Dmitry Kurochkin)++  * Bug Fix: Make darcs diff --patch work even if the patch is within a tag+    (issue966, darcs 2 regression, Dmitry Kurochkin)++  * Quality Assurance: Extend use of Haskell's GADTs to most of the darcs+    code, fixing many potential bugs along the way (Jason Dagit, David Roundy)++  * Quality Assurance: Several improvements to darcs code quality (Petr+    Ročkai)++  * Bug Fix: Correct assumptions made by darcs about Windows file size types+    (issue1015, Simon Marlow, Ganesh Sittampalam)++  * Bug Fix: Support case insensitive file systems using hashed repositories+    in darcs repair (partial issue971, Petr Ročkai). IMPORTANT: This+    introduces a memory use regression, which affects large repositories. We+    found that doing a darcs repair on the GHC repository requires a machine+    with 2 GB of RAM. The regression is well-understood and should be solved+    in the next darcs release. In the meantime we felt that the improved+    robustness was worth the performance trade-off.++  * Quality Assurance: Simplify building darcs on Windows by optionally using+    the zlib and terminfo Haskell packages (Ganesh Sittampalam, Petr Ročkai)++  * User Experience: Better error reporting when patches that should commute+    fail to do so. (Jason Dagit)++  * New Feature: --match "touch filenames", for example --match 'touch+    foo|bar|splotz.*(c|h)' (issue115, Dmitry Kurochkin)++  * User Experience: Improve debugging and error messages in HTTP code (Dmitry+    Kurochkin, David Roundy)++  * Bug Fix: Ensure that darcs responds to Ctrl-C on Window, even if compiled+    with GHC < 6.10 (issue1016, Simon Marlow)++  * New Feature: darcs changes --context now also works with --human-readable+    and --xml-output (issue995, Dmitry Kurochkin)++  * Bug Fix: Always darcs send with context, as if --unified flag were used+    (was implemented in 2.0.2, but not consistently) (David Roundy)++  * Bug Fix: Make sure that darcs get --tag works even when the user hits+    Ctrl-C to get a lazy repository (Dmitry Kurochkin)++  * Quality Assurance: Improvements to documentation and online help, most+    crucially, user-focused help on upgrading to darcs 2. (Trent Buck, Lele+    Gaifax, Simon Michael, Max Battcher)++  * New Feature: darcs changes --number associates each patch with number,+    counting backwards (see the --index feature) (David Roundy)++  * New Feature: ability to match patches on index, for example, darcs changes+    --index=3-6 shows the last three to six patches (David Roundy)++  * User Experience: slightly reduce the verbosity of darcs pull --verbose+    (David Roundy)++ -- Eric Kow <E.Y.Kow@brighton.ac.uk>  Sun, 18 Sep 2008 02:36:45 GMT++darcs (2.0.2)++ -- David Roundy <droundy@darcs.net>  Sun, 24 Jun 2008 01:20:41 GMT++darcs (2.0.1)++  * Bug Fix: Make Ctrl-C work even though darcs is now compiled to use the+    threaded runtime (issue916, David Roundy)++  * New Feature: Include patch count in darcs --version, for example, 2.0.1 (++    32 patches) (David Roundy)++  * Bug Fix: Avoid an error caused by renaming a file on case-insensitive+    file-systems (Eric Kow)++  * Bug Fix and New Feature: Improved XML output (Benjamin Franksen, Lele+    Gaifax, David Roundy)++  * User Experience: Always darcs send with context, as if --unified flag were+    used (David Roundy)++ -- David Roundy <droundy@darcs.net>  Sun, 23 Jun 2008 21:47:07 GMT++darcs (2.0.1rc2)++  * Performance: Faster strings, using Data.Bytestring by default (Gwern+    Branwen, Eric Kow, Ian Lynagh, David Roundy)++  * User Experience: On Windows, use MS-DOS 'edit' as a default editor if+    Emacs and friends are not available (Eric Kow)++  * Bug Fix: On Windows, notice when external programs fail to launch because+    they do not exist (Eric Kow)++  * New Feature: darcs put --no-set-default and --set-default (Nicolas+    Pouillard)++ -- David Roundy <droundy@darcs.net>  Sun, 13 Jun 2008 01:17:45 GMT++darcs (2.0.1rc1)++  * Bug Fix: Fix tag --checkpoint so that darcs get --partial can avoid+    fetching all patches (issue873, David Roundy)++  * User Experience: Better progress reporting [NB: darcs is now compiled with+    threaded runtime by default] (issue739, David Roundy, Bertram Felgenhauer)++  * Performance: Reduce memory usage of darcs put (David Roundy)++  * Bug Fix: Improved date matching (issue793, issue187, Eric Kow)++  * Performance: Fix an optimization in diff-detection (affects darcs whatsnew+    and record) (Pekka Pessi)++  * Quality Assurance: --enable-hpc for checking program coverage (Christopher+    Lane Hinson)++  * Bug Fix: Do not rollback if no primitive patches were selected (issue870,+    Eric Kow)++  * Bug Fix: Make it possible to --dry-run on repositories we cannot write to+    (issue855, Eric Kow, David Roundy)++  * Bug Fix: Avoid a race condition caused by cleaning out the pristine cache+    (issue687, David Roundy)++  * User Experience: When pushing, prints a small reminder when the remote+    repository has patches to pull (Eric Kow, David Roundy)++  * UI changes: --extended-help is now called --overview, no more+    --verify-hash, no more send --unified (David Roundy, Eric Kow)++  * User Experience: Show ssh's stderr output in case it wants to ask the user+    something (issue845, Eric Kow)++  * Bug Fix: Improved interaction with pager (David Roundy, Pekka Pessi, Eric+    Kow)++  * Bug Fix: darcs send -o - (Pekka Pessi)++  * Bug Fix: (regression) Re-enable darcs mv as a means of informing darcs+    about manual renames (issue803, David Roundy)++  * Bug Fix: Fix bugs related to use of threaded runtime (issue776, David+    Roundy)++  * Portability: Respect OS conventions in creation of temporary files (Eric+    Kow)++  * New Feature: Check for and repair patches which remove non-empty files+    (issue815, David Roundy)++  * Bug Fix: Make get --to-match work with hashed repositories (David Roundy)++  * Bug Fix: Conflict-handling with darcs-2 semantics (issue817, David Roundy)++  * Bug Fix: Make --ask-deps ask the right questions (Tommy Pettersson)++  * User Experience: Improved error messages and warnings (issue245, issue371,+    Nicolas Pouillard, David Roundy, Eric Kow)++  * New Feature: darcs trackdown --set-scripts-executable (Reinier Lamers)++  * Quality Assurance: Various improvements to documentation (issue76,+    issue809, Gwern Branwen, Lele Gaifax, Eric Kow, Nicolas Pouillard, David+    Roundy)++  * Bug Fix: Correct detection of incompatibility with future darcs (issue794,+    Eric Kow)++  * User Experience: Make darcs changes --interactive behave more like other+    interactive commands (Eric Kow)++  * Performance: Optimized handling of very large files (Gwern Branwen)++  * New Feature: Colorize added and removed lines, if the environment variable+    DARCS_DO_COLOR_LINES=True (Nicolas Pouillard)++  * New Feature: --remote-repodir flag to allow separate default repositories+    for push, pull and send (issue792, Eric Kow)++  * Performance: Optimized get --to-match handling for darcs 1 repositories+    (Reinier Lamers)++  * Bug Fix: Make changes --repo work when not in a repository (David Roundy)++  * New Feature: darcs changes --count (David Roundy)++ -- David Roundy <droundy@darcs.net>  Sun, 03 Jun 2008 12:43:31 GMT++darcs (2.0.0)++  * Fix silly bug which leads to darcs --version not showing release when it's+    a released version. (David Roundy)++ -- David Roundy <droundy@darcs.net>  Sun, 07 Apr 2008 15:06:38 GMT++darcs (2.0.0rc1)++ -- David Roundy <droundy@darcs.net>  Sun, 01 Apr 2008 15:44:11 GMT++darcs (2.0.0pre4)++  * When darcs encounters a bug, check version versus central server in order+    to decide whether to recommend that the user report the bug.++  * Display duplicate identical changes when using darcs-2 repository format.+    (Issue579)++  * Fix a bug in convert that lead to invalid tags in the converted+    repository. (Issue585)++  * Add an annoying warning when users run convert.++  * Numerous fixes to the time/date matching code, which should now work even+    in central Europe. (Eric Kow)++  * Add support for reading hashed repositories that use SHA256 hashes. The+    plan is to enable writing of SHA256 hashes in the next release. (David+    Roundy)++  * New Feature: Add a 'show authors' command (Eric Kow)++  * darcs.cgi improvements: Patch pages show "Who" and "When" some file+    annotation pages show "who" and "when" with a mouse-over. Also, darcs.cgi+    can now be hosted in a path containing The tilde character. (Zooko, Mark+    Stosberg)++  * User Experience: Improved and added many debugging, error and progress+    messages (David Roundy, Mark Stosberg, Eric Kow)++  * New Feature: New DARCS_PATCHES, DARCS_FILES and DARCS_PATCHES_XML+    environment variables are made available for the posthook system, allowing+    for more easier options to to integrate darcs with other systems. (David+    Roundy, Mark Stosberg)++  * Quality Assurance: Added and updated automated regression tests (Mark+    Stosberg, David Roundy, Eric Kow, Trent Buck, Nicolas Pouillard, Dave+    Love, Tommy Pettersson)++  * Bug Fix: Gzipped files stored in the repo are now handled properly (Zooko,+    David Roundy)++  * Quality Assurance: Various Documentation Improvements (issue347, issue55+    Mark Stosberg, Nicolas Pouillard, Marnix Klooster)++  * Bug Fix: With --repodir, commands could not be disabled (Trent Buck, David+    Roundy)++  * New Feature: tools/update_roundup.pl scripts allows the darcs bug tracker+    to be notified with a darcs patch resolving a particular issue is applied.+    A link to the patch in the web-based repo browser is provided in the+    e-mail notifying bug subscribers. (Mark Stosberg)++  * Internal: Begin work on memory efficiency improvements (David Roundy)++  * Performance: darcs is faster when identifying remote repos handling+    pending changes and running unrecord. (David Roundy)++  * Internal: Source code clean-up and improvements (David Roundy, Jason+    Dagit, Eric Kow, Mark Stosberg)++  * User Experience: A pager is used automatically more often, especially when+    viewing help. (Eric Kow)++  * Bug Fix: push => incorrect return code when couldn't get lock. (issue257,+    VMiklos, David Roundy, Eric Kow, Mark Stosberg)++  * Bug Fix: 'whatsnew' and 'replace' now work together correctly. (Nicolas+    Pouillard, David Roundy)++ -- David Roundy <droundy@darcs.net>  Sun, 21 Mar 2008 15:31:37 GMT++darcs (2.0.0pre3)++  * Fix issue 244, allowing users of darcs changes to specify the new name of+    a file that has an unrecorded mv. (David Roundy, Mark Stosberg, Tuomo+    Valkonen)++  * Fix issue 600, bug in darcs optimize --relink. (David Roundy, Trent Buck,+    Mark Stosberg, Tommy Pettersson)++  * Add a new framework for outputting progress messages. If darcs takes more+    than about one second to run a command, some sort of feedback should now+    be provided. (David Roundy)++  * Rewrite rollback, changing its behavior to be more useful. Rollback now+    prompts for a name for the new "rollback" patches. It also allows you to+    roll back multiple patches simultaneously, and to roll back only portions+    of the patches selected. Altogether, rollback is now more interactive, and+    should also be more useful. (David Roundy)++  * Bug Fix: date parsing is now improved (Mark Stosberg, David Roundy)++  * Performance: Improved speed of darcs pull on very large repos. (David+    Roundy)++  * Fix issue 586, but in darcs repair on hashed and darcs-2 repositories.+    (Nicolas Pouillard)++  * Improve docs for 'darcs init' (Mark Stosberg)++  * Fix typo in test partial.sh which made part of the tests for --partial+    invalid. (Mark Stosberg)++  * Document that darcs handles some types of binary files automatically.+    (issue55, Mark Stosberg)++  * Fix typo in a test that made it compare a file to itself. (Mark Stosberg)++  * Document that single quotes should be used in .darcs/defaults. (issue347,+    Mark Stosberg)++  * New Feature: Automatically create the the global cache if we define we+    want to use it. (David Roundy, Trent Buck)++  * Performance: Improved HTTP pipelining support (Dmitry Kurochkin)++  * Fix issue 571, build failure when termio.h is not found. (Dave Love)++ -- David Roundy <droundy@darcs.net>  Sun, 22 Jan 2008 20:06:12 GMT++darcs (2.0.0pre2)++  * Add instructions in documentation for how to view patches in Mutt (a mail+    reader). (Gwern Branwen)++  * Fix build on Solaris. (Dave Love)++  * Added "auto-optimize" support for hashed inventories, in that darcs+    automatically optimizes inventories when it seems wise (which is currently+    defined as "every time we modify the inventory").++  * Fix expensive performance bugs involved in conflict handling. Thanks to+    Peter for pointing these out!.++  * Fix reading of hashed repositories to avoid reading patches that we don't+    actually need (i.e. foolish inefficiency bug). Thanks to Simon for+    reporting these performance bugs.++  * Added a new --debug flag for debug output.++  * Added compatibility with ghc 6.4. At this point darcs 2 should work with+    any ghc from 6.4 to 6.8.2.++  * Fix bug where parsing of setpref patch called tailPS unnecessarily. (David+    Roundy)++  * Refactor parsing of commands and command line arguments. Implement hidden+    commands. (Eric Kow)++  * Use a single command to initialize a remote repository. This replaces the+    method of stringing together multiple commands with the shell-dependent &&+    operator. (Tristan Seligmann)++  * Allow for files in _darcs/inventories to be gzipped. This is not+    specifically related to issue553, but it fixes a regression introduced by+    the issue553 fix. (Issue553, Eric Kow)++  * Check for potential hash collision in writeHashFile. (Eric Kow)++  * Don't try to write hash file if it already exists, as you can not+    overwrite an open file on Windows. (Issue553, Eric Kow)++  * Close file handles when done reading it lazily. (Eric Kow)++  * Modernize and enhance buggy renameFile workaround by using the+    hierarchical library structure and only catching 'does not exist' errors.+    (Eric Kow)++  * Add "hidden" printer for decorating patches with color for easier reading+    when printed to screen during verbose or debug output, but hides (removes)+    the decoration when printing to the repository files. This is the+    counterpart of the invisible printer, which makes non-human-friendly patch+    contents invisible when printed to the screen. (David Roundy)++  * Add "hidden" printer, for printing things to screen but not file. (David+    Roundy)++  * Make darcs distinguish between repository sub paths and "normal" relative+    paths. Better handling of absolute paths. (Eric Kow)++  * Fix some bugs introduced by Better handling of file paths. (Eric Kow)++  * Handle corner case when polling from self. (issue354, issue358, Eric Kow)++  * Handle corner cases when pulling from current repository. (Issue354,+    Issue358, Eric Kow)++  * Fix bug in make_dotdots when pushing from a sub directory. (issue268, Eric+    Kow)++  * Fix bug in make_dotdots when pushing from a subdirectory. (Issue268, Eric+    Kow)++  * Better handling of file paths. Distinguish between paths to files+    belonging to the repository as well as not belonging to the repository,+    both in absolute and relative form. (Eric Kow)++  * Add path fixing to darcs send, and don't try sending to self. (issue427,+    Eric Kow)++  * Fix path issue for darcs send. (Issue427, Eric Kow)++  * Disable mmap under Windows. (issue320, Eric Kow)++  * Backup unmanaged working dir files as needed. (issue319, issue440, Eric+    Kow)++  * Backup unmanaged files in the working directory when they are overwritten+    by managed files with the same names in pulled or applied patches.+    (Issue319, Issue440, Eric Kow)++  * Offer some advice if sendmail failed. (issue407, Eric Kow)++  * Document behavior of "boring" managed files. (Issue259, Eric Kow)++  * Make Doc a newtype, so we can define a Show instance. (David Roundy)++  * Make make_changelog GHC 6.8 compliant. (Ganesh Sittampalam)++  * GHC 6.8 needs containers package. (Ganesh Sittampalam)++  * Configure hack to deal with openFd -> fdToHandle' renaming in GHC 6.8.+    (Ganesh Sittampalam)++  * Make makefile summarize calls to GHC when compiling. VERBOSE=1 turns the+    long format back on. (Eric Kow)++  * When building, print summarized call to GHC in makefile, instead of very+    long command lines with many boring options. VERBOSE=1 reverts to showing+    options again. (Eric Kow)++  * Add svg logo. (David Roundy)++  * Add mercurial files to the default boring file. (David Roundy)++  * Add patterns for mercurial files to default boring patterns. (David Roundy)++  * Define color versions of traceDoc and errorDoc for debugging. (David+    Roundy)++  * Clarify error message for --last. (issue537, Eric Kow)++  * Clarify in error message that darcs option --last requires a *positive*+    integer argument. (Issue537, Eric Kow)++  * Optimize getCurrentDirectorySansDarcs a little. (Eric Kow)++  * Never create temporary directories in the _darcs directory. (issue348,+    Eric Kow)++  * Never create temporary directories in the _darcs directory. (Issue348,+    Eric Kow)++  * Make revert short help less cryptic. (Eric Kow)++  * Make revert short help less cryptic. (Eric Kow)++  * Make --checkpoint short help more explicit. (issue520, Eric Kow)++  * Make --checkpoint short help more explicit. (Issue520, Eric Kow)++  * Add format infrastructure for darcs-2 repo format. (David Roundy)++  * Always optimize the inventory in 'darcs tag'. (Eric Kow)++  * Fix bug in Tag --checkpoint where the inventory was not updated. (Eric Kow)++  * Fix accidental regression of --no-ssh-cm flag. (Eric Kow)++  * Move conditional #include from Darcs.External to makefile. The GHC manual+    says that this is *not* the preferred option, but for some reason, the+    include pragmas seem to get ignored. Perhaps it is because the requirement+    that the pragmas be on the top of the file conflict with the #ifdef+    statements. In any case, this patch gets rid of the warning on MacOS X:+    warning: implicit declaration of function 'tgetnum'. (Eric Kow)++  * Pass CFLAGS to the assembler. E.g. -mcpu is essential on sparc. (Lennart+    Kolmodin)++  * Optimize 'darcs optimize --reorder'. (David Roundy)++  * Add a table of environmental variables to the manual. (issue69, Eric Kow)++  * Use System.Directory.copyFile for file copying. (Kevin Quick)++  * Implement darcs show contents command. It shows the contents of a file at+    a given version. (issue141, Eric Kow)++  * Make Changes --context --repodir work. (Issue467, Erik Kow)++  * Rename 'query' to 'show', but keep 'query' as an alias. (There is also an+    extra alias 'list' that means the same as show.) The subcommand 'query+    manifest' is renamed to 'show files', and does not list directories by+    default, unless the alias 'manifest' is used. (Eric Kow)++  * Support record -m --prompt-long-comment. (issue389, Eric Kow)++  * Hide the command 'unpull' in favor of 'obliterate'. (Eric Kow)++  * Make option --no-deps work again. It now also works for obliterate,+    unrecord, push and send. (issue353, Tommy Pettersson)++  * Make Record --ask-deps abort if user types 'q' instead of recording+    without explicit dependencies. User is now required to type 'd' (done). If+    the resulting patch is completely empty (no changes and no dependencies)+    the record is automatically canceled. (issue308, issue329, Kevin Quick)++  * Use pure record-access for PatchInfo in Patch.Info. (David Roundy)++  * Improve error message when unable to access a repository. (David Roundy)++  * Switch to using new Haskell standard library function cloneFile for+    copying files. (Kevin Quick)++  * Remove more GUI code. (Eric Kow)++  * Fix some --dry-run messages: "Would push" instead of "Pushing". (issue386,+    Eric Kow)++  * Ensure that logfile for record has trailing newline. (issue313, Eric Kow)++  * Add a stub command 'commit' that explains how to commit changes with+    darcs. (Eric Kow)++  * Makes non-repository paths in DarcsFlags absolute. (issue427, Zachary P.+    Landau)++  * Fix problem with missing newline in inventory, to simplify for third party+    scripts. (Issue412, Eric Kow)++  * Add all pulled repositories to _darcs/prefs/repos. (Issue368, Eric Kow)++  * Implement Apply --dry-run. (Issue37, Eric Kow)++  * Never change defaultrepo if --dry-run is used (issue186, Eric Kow)++  * Filter out any empty filenames from the command line arguments. (Issue396,+    Eric Kow)++  * Use prettyException in clarify_errors so we don't blame user for darcs'+    own errors. (Issue73, Eric Kow)++  * Rename command 'resolve' to 'mark-conflicts'. 'Resolve' remains as a+    hidden alias. (issue113, Eric Kow)++  * Make 'query manifest' list directories by default. (issue456, Eric Kow)++  * Allow --list-options even if command can not be run. (issue297, Eric Kow)++  * Make 'unadd' an alias for 'remove'. Make 'move' an alias for 'mv'. Add a+    stub for 'rm' that explains how to remove a file from a darcs repository.+    (issue127, Eric Kow)++  * Fix <supercommand> --help. (Issue282, Eric Kow)++  * New --nolinks option to request actual copies instead of hard-links for+    files. (Kevin Quick)++  * Harmonize capitalization in flags help. (Eric Kow)++  * Define datarootdir early enough in autoconf.mk.in. (Issue493, Eric Kow)++  * Fix a bug where Get --partial would use a checkpoint without detecting it+    was invalid. Checkpoints can for example become invalid after an Optimize+    --reorder. (issue490, David Roundy)++  * User Agent size limit for curl gets is removed. (Issue420, Kevin Quick)++  * Don't garb string parameters passed to libcurl, as required by the api+    specification. (Daniel Gorin)++  * Fix handling of --repo with relative paths. (Eric Kow)++  * Check for gzopen in zlib. curl depends on zlib and is detected prior to+    zlib by the configure file, but without the -lz flag on some versions.+    (Andres Loeh)++  * Switch to haskell's System.Process under Unix for execution of external+    commands; requires GHC 6.4. (Eric Kow)++  * Remove (some more) conflictor code. (Eric Kow)++  * Remove (unused) conflictor code. (David Roundy)++  * Support makefile docdir/datarootdir variables. (Dave Love)++  * Added prehooks that works the same as posthooks, but they run before the+    command is executed. This can for example be used to convert line endings+    or check character encodings before every Record. The darcs command aborts+    if the prehook exits with an error status. (Jason Dagit)++  * Use system instead of rawSystem for calling interactive cmds in Windows,+    which lets us support switches, for example, in DARCS_EDITOR. (Eric Kow)++  * add support for partial and lazy downloading of hashed repositories.+    (David Roundy)++  * Fix refactoring bug in Checkpoints where we sometimes looked for things in+    the wrong place. (David Roundy)++  * Fail on error in get_patches_beyond_tag. This will expose any bugs where+    we use this function wrongly. (As was the case in darcs check --partial+    with hashed inventories.) (David Roundy)++  * Restructure the source tree hierarchy from a mostly flat layout to one+    with directories and subdirectories that reflects the modularity of the+    source. (Eric Kow)++  * In tests, don't assume grep has -q and -x flags. (Dave Love)++  * Add --output-auto-name option to Send (Zachary P. Landau)++  * Added regression testing for the "pull --complement" operation. Updated+    documentation to explain why "darcs pull --complement R1 R1" is the same+    as "darcs pull R1" instead of the empty set. (Kevin Quick)++  * Change all "current" to "pristine" in manual and help texts. (Tommy+    Pettersson)++  * Added the ability to specify the --complement argument on the pull command+    as an alternative to --intersect and --union. When --complement is+    specified, candidate patches for a pull are all of the pullable patches+    that exist in the first repository specified but which don't exist in any+    of the remaining repositories (the set-theory complement of the first+    repository to the union of the remaining repositories). (Kevin Quick)++  * Fix bug where darcs would try to write temporary files in the root+    directory (/) if it couldn't find a repository root to write them in. Now+    it uses the current directory in that case. (issue385, Zachary P. Landau)++  * Make write_repo_format use the same syntax as read_repo_format when+    dealing with different repository formats. (Benedikt Schmidt)++  * Remove some unused functions from Population. (Eric Kow)++  * Use IO.bracket instead of Control.Exception.bracket in Exec, to restore+    the old way darcs works on *nix. (Eric Kow)++  * Import bracketOnError from Workaround instead of Control.Exception to+    support GHC 6.4. (Eric Kow)++  * Switch to haskell's System.Process under Windows for execution of external+    commands; requires GHC 6.4. (Simon Marlow)++  * Fix bug where darcs ignored command arguments in the VISUAL environment+    variable. (issue370, Benedikt Schmidt)++  * Make annotate work on files with spaces in the name. (Edwin Thomson)++  * Prettify exceptions in identifyRepository. (Juliusz Chroboczek)++  * QP-encode patch bundles transfered with the Put command. (Juliusz+    Chroboczek)++  * Fix bug in darcs get --tag that left cruft in pending. (David Roundy)++  * Fix bug when trying to 'darcs mv foo foo'. (issue360, David Roundy)++  * Separate comment from OPTIONS pragma for GHC 6.4 compatibility. (Eric Kow)++  * Make hashed inventories support optimize and reordering. (David Roundy)++  * Change all Maybe Patch to the new type Hopefully Patch, which is similar+    to Either String, for storing patches that may or may not exist. This+    should make it much easier to improve error reporting. (David Roundy)++  * Fix pending bug that broke several_commands.sh. (David Roundy)++  * Fix hashed inventory bug in Add. (David Roundy)++  * Make Get and Put reuse code for Initialize. This makes Put accept any+    flags that Init accepts. (David Roundy)++  * Fix new get to not mess up pending. (David Roundy)++  * External resolution can resolve conflicting adds. (Edwin Thomson)++  * Only copy the files that are needed for the resolution, when invoking an+    external resolution tool. This saves much time and resources on+    repositories with many files in them. (Edwin Thomson)++  * Change message in 'darcs check' from "applying" to "checking". (issue147,+    Tommy Pettersson)++  * Add code fore hashed inventories. (David Roundy)++  * New option for Diff: --store-in-memory. darcs diff usually builds the+    version to diff in a temporary file tree, but with --store-in-memory it+    will represent the files in memory, which is much faster (unless the tmp+    directory already is a ram disk). (Edwin Thomson)++  * Fix bug where duplicated file names on the command line would fool darcs.+    (issue273, Tommy Pettersson)++  * When recording with option --pipe, assume users local timezone if none is+    given, instead of UTC. Except if the date is given in raw patch format+    'yyyymmddhhmmss' it is still parsed as UTC. (issue220, Eric Kow)++  * Account for timezone information, e.g. in dates when recording with option+    --pipe. (issue173, Eric Kow)++  * Fix bug in refactoring of get. (David Roundy)++  * Refactor repository handling to allow truly atomic updates. (David Roundy)++ -- David Roundy <droundy@darcs.net>  Sun, 16 Dec 2007 20:16:47 GMT++darcs (1.0.9)++  * Make shell harness failures fatal in Makefile. (Eric Kow)++  * Bugfix, fix bug where we add a file but not its boring parent directory.+    (David Roundy)++  * Allow escaped quotes in 'quoted' for match text. (Dave Love)++  * Don't exit with failure when tests_to_run is used and there are no perl+    tests. (David Roundy)++  * Apply patches "tolerantly" to the working directory; don't quit, but print+    a warning for every problem and continue. This is a workaround for a bug+    in darcs where it sometimes fails to update the working directory. When+    darcs updates the working directory it has already successfully updated+    the inventory and the pristine cache, so the repository itself is not+    corrupted. However, an incomplete update to the working directory results+    in unintended differences between the working and pristine tree, looking+    like spurious unrecorded changes. These can be easily removed with 'darcs+    revert', but spurious changes have to be manually sorted out from real+    unrecorded changes. By darcs no longer quiting at the first problem, more+    of the working tree gets updated, giving less spurious changes and less+    manual work to fix the mess should the bug bite you. (issue434, Eric Kow,+    David Roundy)++  * Add a README file, created from HACKING. (issue287, Eric Kow)++  * New command, query tags (similar to 'darcs changes -t .) (Florian Weimer)++  * Include the query commands in the manual. (Florian Weimer)++  * The ssh control master is now off by default (it seems to hang on some+    large repositories). The option --disable-ssh-cm is replaced by the two+    options --ssh-cm and --no-ssh-cm (default). (Eric Kow)++  * Do not append a colon to host name when calling sftp. This does not solve+    all of issue362, just a minor annoyance along its way. (issue362, Eric Kow)++  * Get 'open' and 'psignal' declared on Solaris. (Dave Love)++  * Zsh completion supports new _darcs/pristine repository format. (Georg Neis)++  * Add documentation for DARCS_PAGER. (Benedikt Schmidt)++  * Turning off and on the ssh control master works for the Changes command.+    (issue383, Georg Neis)++  * Optimize unrecorded file moves with unrecorded file adds and removals.+    That is, if you add, rename and remove files multiple times without+    recording, whatsnew (and record) will only see the final result, not the+    whole sequence of moves. (Marco Tulio Gontijo e Silva)++  * Fix link error with errno for gcc 4.12 / glibc 2.4. (Benedikt Schmidt)++  * Remove the confusing text "user error" from some of GHC's error+    descriptions. (Juliusz Chroboczek)++  * Check for and fail build configuration if module quickcheck isn't+    available. (issue369, David Roundy)++  * Make darcs push QP-encode the bundle before transferring. This should+    hopefully fix issues with scp/sftp corrupting bundles in transit. (Juliusz+    Chroboczek)++  * Make it very clear in the documentation that the options --from and+    --author does NOT have anything to do with the sender or email author when+    sending patches as email with the darcs Send command. (Kirsten Chevalier)++  * Allow commented tests in tests_to_run. (David Roundy)++  * Make it an error to Put into a preexisting directory. Often one could be+    tempted to try to put into a directory, expecting to have the repository+    created as a subdirectory there, and it is confusing to have instead the+    repository contents mingled with whatever was already in that directory.+    (David Roundy)++  * Explicitly flush output on Windows after waiting for a lock, because+    Windows' stdout isn't always in line-buffered mode. (Simon Marlow)++  * Improve unhelpful "fromJust" error message in Push command. (Kirsten+    Chevalier)++  * Support option --all for Obliterate, Unpull and Unrecord. (issue111, David+    Roundy)++  * Ignore failure to set buffering mode for terminal in some places+    (supposedly fixes issue41, issue94, issue146 and issue318). (Tommy+    Pettersson)++  * Buildfix, don't import Control.Exception functions when compiling on+    Windows. (Edwin Thomson)++  * Add make rules for tag files. (Dave Love)++  * Add a semi-automated test for SSH-related things. (Eric Kow)++  * Allow Dist --dist-name to put the tar file in any directory by giving a+    full path as the dist name. (issue323, Wim Lewis)++  * Add rigorous error checking when darcs executes external commands. All+    low-level C return values are checked and turned into exceptions if they+    are error codes. In darcs main ExecExceptions are caught and turned into+    error messages to help the user. (Magnus Jonsson)++  * Redirect error messages from some external commands to stderr. (Tommy+    Pettersson)++  * Make configure fail if a required module is missing. (David Roundy)++  * The options for turning off and on the ssh control master works from the+    defaults file. (issue351, Tommy Pettersson)++  * Amend-record now keeps explicit dependencies (made with --ask-deps) from+    the amended patch. (issue328, Edwin Thomson)++  * Make libcurl use any http authentication. This let darcs use repositories+    protected with digest authentication. (Tobias Gruetzmacher)++  * Turning off and on the ssh control master works for the Send command.+    (Eric Kow)++  * Redirect stderr to Null when exiting SSH control master. This suppresses+    the output "Exit request sent" not suppressed by the quiet flag. (Eric Kow)++  * Fix curses stuff, especially on Solaris 10. (Dave Love)++  * Annotate various boring patterns. (Dave Love)++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 03 Jun 2007 21:37:06 GMT++darcs (1.0.9rc2)++  * Pass e-mail address only for %t in --sendmail-command. Msmtp seems to+    require this. Note that the full address is encoded in the message body.+    (Eric Kow)++  * Show error messages on stderr when starting and stopping the ssh control+    master. (Tommy Pettersson)++  * Rewrite check for spoofed patches with malicious paths. The check can now+    be turned off with the option --dont-restrict-paths (issue177). The new+    check only works for Apply and Pull, and it only looks at the remote+    patches. A more complete check is desirable. (Tommy Pettersson)++  * Add LGPL file referenced in fpstring.c (Dave Love).++  * Update FSF address in copyright headers(Dave Love).++  * New default boring file patterns: ,v .# .elc tags SCCS config.log .rej+    .bzr core .obj .a .exe .so .lo .la .darcs-temp-mail .depend and some more+    (Dave Love).++  * Move darcs.ps to the manual directory (Tommy Pettersson).++  * Pass -q flag to scp only, not ssh and scp. Putty's SSH (plink) does not+    recognize the -q flag. (issue334, Eric Kow)++  * Bugfix. Make darcs.cgi look for both pristine and current (Dan).++  * Don't lock the repo during `query manifest' (issue315, Dave Love).++  * Buildfix. Include curses.h with term.h (issue326, Dave Love).++  * Bugfix. Unrecord, Unpull and Obliterate could mess up a repository+    slightly if they removed a tag with a corresponding checkpoint. Only the+    commands Check and Repair were affected by the damage, and Get would also+    copy the damage to the new repository. (issue281, Tommy Pettersson)++  * Add a HACKING file with helpful references to pages on the darcs wiki+    (Jason Dagit).++  * New boring file patterns: hi-boot o-boot (Bulat Ziganshin, Eric Kow).++  * Require 'permission denied' test for MacOS X again. Perhaps something in+    MacOS X was fixed? (Eric Kow).++  * Look for Text.Regex in package regex-compat. Needed for GHC 6.6. (Josef+    Svenningsson)++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 16 Nov 2006 14:03:51 GMT++darcs (1.0.9rc1)++  * Improved handling of input, output and error output of external commands.+    Null-redirection on windows now works. Only stderr of ssh is+    null-redirected since putty needs stdin and stdout. (issue219, Eric Kow,+    Tommy Pettersson, Esa Ilari Vuokko)++  * Optimize away reading of non-managed files in summary mode of Whatsnew+    --look-for-adds (issue79, Jason Dagit).++  * Remove direct dependency to mapi32.dll; Improve MAPI compatibility. (Esa+    Ilari Vuokko)++  * Ignore .git if _darcs is found (Juliusz Chroboczek).++  * Add a haskell code policy test to catch uses of unwanted functions, bad+    formating and such. (Tommy Pettersson)++  * If the logfile supplied with option --logfile does not exist, fail instead+    of inserting no long comment. (issue142, Zachary P. Landau)++  * Make the pull 'permission test' work when run as root (Jon Olsson).++  * Handle unsimplified patches when further simplifying the summarized+    output. For unknown reason (a possibly previous version of) darcs allows a+    single patch to Add and Remove the same file in a single patch. The+    Changes command used to combine them, showing just a Remove. (issue185,+    Lele Gaifax)++  * Add workaround for HasBounds that was removed in GHC 6.6 (Esa Ilari+    Vuokko).++  * Really make --disable-ssh-cm work (issue239, Eric Kow).++  * Fix false errors in pull.pl test (David Roundy).++  * Clean up docs on DarcsRepo format (David Roundy).++  * Use stdin for passing the batch file to sftp, to allow password-based+    authentication (issue237, Eric Kow, Ori Avtalion).++  * Make darcs fail if the replace token pattern contains spaces. It would+    otherwise create a non-parsable patch in pending. (issue231, Tommy+    Pettersson)++  * Set a default author in the test suite harness so not every test has to do+    so. (Tommy Pettersson).++  * Run external ssh and scp commands quietly (with the quiet flag), but not+    sftp which doesn't recognize it (issue240). This reduces the amount of+    bogus error messages from putty. (Eric Kow)++  * Implement help --match, which lists all available forms for matching+    patches and tags with the various match options (Eric Kow).++  * Added .elc and .pyc suffixes to default binary file patterns (Juliusz+    Chroboczek ).++  * Added a link to the 'projects' part of the cgi repository interface, so+    that you go back to the project list (Peter Stuifzand).++  * Add a test suite for calling external programs (Eric Kow).++  * Don't warn about non-empty dirs when in quiet mode (Eric Kow).++  * New option --umask. This is best used in a repository's defaults file to+    ensure newly created files in the repository are (not) readable by other+    users. It can also be used when invoking darcs from a mail reader that+    otherwise sets a too restrictive umask. (Issue50, Juliusz Chroboczek)++  * Only check for ssh control master when it might be used. This suppresses+    the annoying "invalid command" error message. (Issue171, Eric Kow)++  * Fail with a sensible message when there is no default repository to pull+    from. (Lele Gaifax)++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 08 Oct 2006 17:52:07 GMT++darcs (1.0.7)++  * Fixed bug leading to a spurious "darcs failed: resource vanished" error+    message when darcs output is piped to a program such as head that then+    exits. (Issue160, David Roundy)++  * New option --diff-command overrides the default value of "diff" when darcs+    calls an external program to show differences between versions (Eric Kow).++  * Use the ControlMaster feature in OpenSSH version 3.9 and above to+    multiplex ssh sessions over a single connection, instead of opening a new+    connection for every patch (Issue32, Eric Kow).++  * Add a standalone graphical interface (experimental). The gui code prior to+    this patch allows graphical darcs forms to be run from the command line.+    This builds off that functionality by adding a graphical front-end,+    allowing users to access these forms with a click of a button. In other+    words, this allows users to run darcs without the command line. (Eric Kow)++  * Make unpull, unrecord, obliterate accept --gui (Eric Kow).++  * Freshen GUI code so that it compiles (Eric Kow).++  * Provide more information when a remote repository can't be correctly+    identified. (Juliusz Chroboczek)++  * The Send command can save, reuse and delete the accompanying description+    in a logfile. (Zachary P. Landau)++  * Display list of subcommands when getting help on a supercommand. (Eric Kow)++  * A proper fix for the problem with rmdir when there are non-managed files+    left in the working copy of the directory so it can't really be removed.+    This solves the two related problems with a missguiding error message in+    one case, and an unreported repository corruption in the other. Now there+    is no false warning and no repository coruption. (issue154, Eric Kow)++  * Escaping of trailing spaces and coloring now works with in the pager+    called with 'p' from interactive dialogues. (issue108, Tommy Pettersson)++  * Added default recognized binary file extensions: bmp, mng, pbm, pgm, pnm,+    ppm, tif, tiff. (Daniel Freedman)++  * Added a RSS link to common.xslt. (Peter Stuifzand)++  * Make short option -i a synonym for --interactive (Zachary P. Landau).++  * Improved argument substitution for --external-merger. All apperences of %N+    are replaced, not only those occurring as single words. (Daan Leijen)++  * Transition from _darcs/current to _darcs/pristine completed. New+    repositories are created with a "pristine" directory. Previous versions of+    darcs have been looking for this directory since version 1.0.2, but older+    versions than that can't read the new repository format. (Juliusz+    Chroboczek)++  * If you specify a repository directory, any absolute paths prefixed by this+    directory are converted to be ones relative to the repodir. (issue39, Eric+    Kow)++  * The --repodir flag works with many more commands: changes, dist, get,+    optimize, repair, replace, setpref, tag, trackdown. (RT#196, RT#567, Eric+    Kow)++  * The --repodir flag works with initialize command, and tries to create it+    if it does not exists. (RT#104, Eric Kow)++  * Add autom4te.cache to default boring patterns. (Kirill Smelkov)++  * Don't create temporary copies of the repository for the external merger+    program, unless there is for sure some conflict to resolve. (Edwin Thomson)++  * Modify Changes --interactive dialogue to behave like other interactive+    commands: accept 'y' and 'n' as answers and exit automatically after last+    question. (Zachary P. Landau)++  * Unnamed patches are now called "changes" in the interactive patch+    selection dialogues. (Tommy Pettersson)++  * Treat Enter as an invalid response in single character prompt mode, and+    give feedback instead of being mysteriously silent and unresponsive.+    (RT#261, Eric Kow)++  * Make short option -f a synonym for --force (Zooko).++  * Posthooks no longer cause an output message about success or failure,+    unless the --verbose option is used. (Jason Dagit)++  * Fix crash when using changes --interactive with --patch or --match+    (Zachary P. Landau).++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 13 May 2006 17:14:38 GMT++darcs (1.0.6)++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 28 Feb 2006 11:18:41 GMT++darcs (1.0.6rc1)++  * Check paths when applying patches to files and directories to stop+    maliciously handcrafted patches from modifying files outside of the+    repository or inside darcs private directories (issue48, Tommy Pettersson).++  * Revert optimization that sometimes applied patches incorrectly and+    corrupted the repository. This make darcs somewhat slower when applying+    patches. A full pull of the darcs repository itself takes 50% longer.+    (issue128, Tommy Pettersson).++  * Fix bug in Get --tag that produced a corrupt repository (issue67, Edwin+    Thomson).++  * Add newline between long comment and changed files list in dry-run summary+    to remove ambiguity (Edwin Thomson).++  * Extended date matching functionality: ISO 8601 dates and intervals, a+    larger subset of English like "yesterday at noon" (issue31/RT#34, Eric+    Kow).++  * Allow rename to different case (RT #466, Eric Kow).++  * Save long comment in a file if record fails the test run (Zachary P.+    Landau).++  * Fix win32 build breaks (Will Glozer).++  * Make --exact-version work when darcs is built from distributed tar ball+    (Marnix Klooster).++  * Coalesce pending changes created with setpref (issue70/RT#349, Eric Kow).++  * Support --interactive option in changes command (issue59, Zachary P.+    Landau).++  * New help command (RT#307, Eric Kow).++  * Add --without-docs option to configure (Richard Smith).++  * Obey normal autoconf conventions. Allows you to 'make install prefix=...'+    and doesn't change default for sysconfdir. (Dave Love)++  * Fix bug with non-existing directories. (David Roundy)++  * Remote apply does not use cd to change current directory to target+    directory any more. It uses --repodir when invoking remote darcs. This may+    break some darcs wrappers. (Victor Hugo Borja Rodriguez)++  * Support signed push (Esa Ilari Vuokko).++  * Added support for pulling from multiple repositories with one pull. The+    choice of --union/--intersection determines whether all new patches are+    pulled, or just those which are in all source repositories. This feature+    implements a suggestion by Junio Hamano of git. (David Roundy)++  * Patch bundle attachments get a file name, based on the first patch.+    (Zachary P. Landau)++  * The send command now takes a --subject flag. (Joeri van Ruth)++  * Fix --set-scripts-executable to work also when getting a local repository.+    (issue38, Eric Kow)++  * Removed the helper program darcs-createrepo. It was used for guided settup+    of a darcs repository and a corresponding user account to accept patches+    from signed emails. (issue14, Jason Dagit)++  * Print out the patch name when a test fails. (Zachary P. Landau).++  * Bugfix for --sendmail-command in Windows (Esa Ilari Vuokko).++  * Make apply --verify work with GnuPG in Windows (Esa Ilari Vuokko)++  * Bugfix for handling of absolute paths in Windows (issue47, Will Glozer)++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 19 Feb 2006 23:19:19 GMT++darcs (1.0.5)++  * Fixes for Windows (Will Glozer).++  * Adapt makefile to work with current ghc 6.4 (Will Glozer).++  * --help and --list-commands ignore other options (issue34, Eric Kow).++  * Fix apply with --verify for patch bundles signed by GnuPG in Windows (Esa+    Ilari Vuokko).++  * Make patch selection options together with --context work again (Daniel+    Bünzli).++  * Make option --commands outside of a repository work again (issue9, David+    Roundy).++  * Bugfix for pushing with ssh under Windows (issue15, Will Glozer).++  * Fix superfluous input bug in test suite (Florian Weimer).++  * Many English and markup fixes (Dave Love).++ -- Tommy Pettersson <ptp@lysator.liu.se>  Sun, 07 Dec 2005 11:27:30 GMT++darcs (1.0.4)++  * Fixed a bug in the external conflict resolution code. (bug #577, David+    Roundy)++  * Fixed a bug which made apply sometimes (but rarely) fail to check the the+    hash on patch bundles corrupted in just the wrong way. (David Roundy)++  * Added a simple check to darcs replace that avoids tokenizing lines that+    don't contain the token we're replacing. I feel a bit bad about+    introducing an optimization this late in the release cycle, but it makes a+    huge difference, and really should be safe. (David Roundy---famous last+    words)++  * Fixed bug where darcs didn't honor the SSH_PORT environment variable when+    calling sftp. (bug #576, fix suggested by Nicolas Frisby)++  * Avoid putting a wrongly-named directory in the tarball generated by darcs+    dist, if the name we wanted already exists in $TMPDIR. (Simon McVittie)++  * Fixed bug which caused "pull_firsts_middles called badly" errors when+    running record with --ask-deps flag. (bug #476, David Roundy)++  * Fixed bug where 'darcs changes --context' created a context that contained+    escapes that prevented its use with send. (bug #544, David Roundy)++  * Make interactive push/pull/send/apply respect the --summary option by+    printing each patch as if you had hit 'x'. (David Roundy, bug #512)++  * Fix bug when calling whatsnew --summary when a file without a trailing+    newline has been deleted. (David Roundy)++  * Fix --set-scripts-executable to work again. This feature had been broken+    since version 1.0.3. (David Roundy)++  * Simple (safe) fix for a bug which caused darcs to run out of file+    descriptors when pulling over 1000 patches. (David Roundy)++  * Fix bug in perl parts of test suite which led to spurious warning+    messages. (David Roundy)++  * Fix bug in configure when compiling darcs from tarball on a system that+    has no darcs present. (David Roundy)++  * Fix bug that shows up when recording in a repository lacking a pristine+    tree. (David Roundy)++ -- David Roundy <droundy@darcs.net>  Sun, 13 Nov 2005 13:44:31 GMT++darcs (1.0.4pre4)++  * Fix error in install target of makefile, which was introduced in+    1.0.4pre3. (Andres Loeh)++  * Fix problem where make install modified the permissions on system+    directories. (David Roundy, bug #494)++  * Fix bug in display when whatsnew is given "-l" twice. (David Roundy, bug+    #501)++  * Added support for --posthook to all commands. (Jason Dagit)++  * Made repair able to work on partial repositories. (fixes bug #189)++  * Changed the delimiter in the long-comment file from ***DARCS*** to ***END+    OF DESCRIPTION*** and clarified its meaning a bit. (Jason Dagit and David+    Roundy)++  * Added code to allow darcs to apply some patch bundles that have had+    carriage returns added to their line endings. (David Roundy, bug #291)++  * Make darcs accept command line flags in any order, rather than requiring+    that they precede file, directory or repository arguments. Fixes bug #477+    (David Roundy)++  * Modified darcs get to display patch numbers rather than a bunch of dots+    while applying patches during a darcs get. Also added similar feedback to+    the check and repair commands. (Mat Lavin, bug #212)++  * Made revert --all not ask for confirmation, so it can be used in+    scripting, as one would use pull --all or record --all. (Jani Monoses)++  * Added file ChangeLog.README explaining how to add entries to the+    changelog. (Mark Stosberg and David Roundy)++  * Fixed incompatibility with somewhat older versions of libcurl. (Kannan+    Goundan)++  * Fixed bug that showed up when after editing a long comment, the long+    comment file is empty. (David Roundy, bug #224)++ -- David Roundy <droundy@darcs.net>  Sun, 01 Sep 2005 11:04:18 GMT++darcs (1.0.4pre2)++  * (EXPERIMENTAL) Added support for reading and writing to git repositories.+    There remain efficiency issues with the handling of git merges and darcs+    is not yet able to either create a new git repository, or to pull from a+    remote git repository. See building darcs chapter in manual for+    instructions on building darcs with git support. (Juliusz Chroboczek,+    configuration contributed by Wim Lewis)++  * Add new "query manifest" command to list files and/or directories in+    repository. Add some related infrastucture to support "subcommands".+    (Florian Weimer)++  * Make configure properly detect that we're on windows when building under+    mingw. (David Roundy)++  * Fixed bug #208: error when specifying pulling from a relative default+    repository if we are ourselves within a subdirectory of our repository.+    (David Roundy)++  * Change internal mechanism for writing the "pending" file to be (hopefully)+    more robust. (David Roundy, original idea by Ian Lynagh)++  * Fixed a bug that caused get --partial to fail sometimes. (David Roundy)++  * Made push/pull --verbose --dry-run now display contents of patches,+    analogous to the behavior of changes --verbose. (Jim Radford)++  * Various build system cleanups. (Peter Simons)++ -- David Roundy <droundy@abridgegame.org>  Sun, 31 Jul 2005 12:10:29 GMT++darcs (1.0.4pre1)++  * Performance improvement: Several commands now read patches lazily, which+    reduces memory usage. A test of 'darcs check' on the Linux kernel+    repository showed the memory usage was nearly cut in half, from about 700+    Megs to 400. Coded by David Roundy.++  * New feature: darcs put, the easiest way to create a remote repo, symmetric+    with 'darcs get'. Coded by Josef Svenningsson.++  * Performance improvement: RT#222: darcs performs better on files with+    massive changes. Coded by Benedikt Schmidt.++  * New Feature: darcs optimize now has "--modernize-patches" and+    "--reorder-patches" flags. See the manual for details.++  * Performance improvement: Using 'darcs diff' is now exponentially faster+    when comparing specific files in the working directory to the most recent+    copy in the repo. Coded by kannan@cakoose.com.++ -- David Roundy <droundy@abridgegame.org>  Sun, 18 Jul 2005 11:22:34 GMT++darcs (1.0.3)++  * Fixed bug #396: error when specifying a removed file on the command line+    of darcs record.++ -- Tomasz Zielonka <tomasz.zielonka@gmail.com>  Sun, 24 May 2005 21:51:27 GMT++darcs (1.0.3rc2)++  * Internals: darcs' ChangeLog is automatically generated from repo history+    and a database of ChangeLog entries (Tomasz Zielonka)++  * Fixed: RT#370: --tags work in unpull and unrecord (Tommy Pettersson)++  * New feature: added support for displaying patches with pager when+    selecting patches (Benedikt Schmidt)++  * New feature: new match type "exact" (John Goerzen)++  * Feature: unrevert accepts --all and --interactive options (Jani Monoses)++  * Fixed: darcs works with nvi (Benedikt Schmidt)++ -- Tomasz Zielonka <tomasz.zielonka@gmail.com>  Sun, 15 May 2005 08:56:17 GMT++darcs (1.0.3rc1)++  * New Feature: darcs.cgi now uses appropriate caching headers. This will+    make repeated calls to the same pages by cache-aware browsers much faste+    in some cases. It also means that darcs.cgi can be usefully combined with+    a cache-aware proxy for even better performance. (Will Glozer)++  * New feature: more control over color and escaping in printed patches,+    alternative color scheme, escaping of trailing spaces (Tommy Pettersson)++  * Fixed: fixed bug manifesting with failed createDirectory (David Roundy)++  * Internals: RT#255, several welcome refactors were made to the test suite,+    including comprehensible shell test script output, improved portability,+    and easier maintenance. (Michael Schwern).++  * New Feature: RT#245: Using --look-for-adds with 'whatsnew' implies+    --summary. This should save some typing for the common case. (Karel+    Gardas, Mark Stosberg)++  * New Feature: RT#231: darcs gives better feedback now if you try to record+    nonexistent files or directories. (Karel Gardas, Mark Stosberg)++  * New feature: send accepts --sendmail-command that allows to customize the+    command used for sending patch bundles (Benedikt Schmidt)++  * Fixed: RT#266: Adding a non-existent dir and file gives the expected+    message now. (Tomasz Zielonka).++  * Fixed: RT#10, a missed conflict resolution case. More accurately, we+    noticed at had been fixed some point. A regression test for it was added.+    (Tomasz Zielonka, Mark Stosberg)++  * New feature: darcs tag can now accept the tag name on the command line+    (RT#143). (Josef Svenningsson, Mark Stosberg, David Roundy)++  * New feature: unrecord and unpull have a more powerful interface similar to+    'darcs pull'. This allows for multiple patch selection. Coded by Tommy+    Pettersson.++  * Bug fix: RT#305: Removed '--patch' from the 'changes', which conflicted+    with the new '--patches' option.++  * New feature: Automatically add parent directories for darcs add. (RT#20)+    Coded by Benedikt Schmidt.++  * Add helpful diagnostic message when there is a failure while pulling+    (RT#201)++ -- Tomasz Zielonka <tomasz.zielonka@gmail.com>  Sun, 26 Apr 2005 00:25:54 GMT++darcs (1.0.2)++  * No changes from 1.0.2rc4.++ -- David Roundy <droundy@darcs.net>  Fri,  4 Feb 2005 07:33:09 -0500++darcs (1.0.2rc4)++  * More documentation improvements, plus one clearer error message.+  * Fixed (new since 1.0.1) bug which broke darcs repair.+  * Fixed problem with makefile which caused spurious relinkings.+  * Fixed bug in new optimize --relink command, which could cause+    repository corruption.++ -- David Roundy <droundy@abridgegame.org>  Wed, 2 Feb 2005 06:24:19 -0500++darcs (1.0.2rc3)++  * Documentation improvements related to Juliusz new code.+  * Fixed longstanding leaks in zlib/threads code.+  * Fixed some bugs in the new optimize --relink code.+  * Fixed bug in darcs diff when the repository name is empty.++ -- David Roundy <droundy@abridgegame.org>  Sat, 29 Jan 2005 07:28:39 -0500++darcs (1.0.2rc2)++  * Fixed bug on win32 when there are spaces in a repositories path and an+    external program (i.e. ssh) is called. (Will Glozer)++ -- David Roundy <droundy@abridgegame.org>  Thu, 27 Jan 2005 06:46:37 -0500++darcs (1.0.2rc1)++  * Added experimental support for repositories without a "pristine tree"+    This is the new name for the cache stored in _darcs/current/.+    (Juliusz Chroboczek)+  * Added an optimize --relink command to save disk space when using+    multiple repositories. (Juliusz Chroboczek)+  * Ignore conflict markers in the boring and binaries files.+  * Fixed bug in get --partial when patches are in an unusual order.+    (Andrew Johnson)+  * Fixed bug which caused a crash on a local get of a repository owned by+    another user.+  * Fixed bug in changes/annotate that shows up when a directory has been+    moved.+  * Allow ncurses in addition to curses in configure.+  * Added --set-scripts-executable option. (Karel Gardas)+  * Added configure option to fix path to sendmail even if it's not+    present.+  * Made bash completion more robust regarding shell special chars.+  * Added konquerer workaround to cgi annotate. (Will Glozer)+  * Addressed bug #114 - provide a better error when you accidently try to+    pull from yourself. (Mark Stosberg)+  * Made a few documentation improvements.+  * Made http user agent reflect the darcs and libcurl version.+  * Fixed commute bug in merger code.+  * Fixed bug in decoding mime messages.++ -- David Roundy <droundy@abridgegame.org>  Wed, 26 Jan 2005 08:51:24 -0500++darcs (1.0.1)++  * Made darcs changes --context work on an empty repo.+  * Fixed bug in relative directories as arguments to pull/push.+  * Fixed bug leading to extraneous changes in pending.+  * Fixed bug #137 - XML escaping for >.+  * Fixed gui code to compile with wxhaskell 0.8 (but it's still buggy).++ -- David Roundy <droundy@abridgegame.org>  Tue, 14 Dec 2004 08:16:10 -0500++darcs (1.0.1rc3)++  * Made it so adding and removing a file doesn't leave changes in pending.+  * Fixed bug in creating the file to be edited for the long comment.+  * Made "bug in get_extra" message explain possible cause of the problem,+    which is related to a bug in commutation that made it into version+    1.0.0.+  * Fixed stubborn bug in annotate.+  * Fixed problem when unrecording binary file patches.++ -- David Roundy <droundy@abridgegame.org>  Sat, 11 Dec 2004 14:23:53 -0500++darcs (1.0.1rc2)++  * Various optimizations.+  * darcs now supports an arbitrary number of transport protocols through the+    use new environment variables. See DARCS_GET_FOO in the 'Configuring+    Darcs' chapter in the manual for more details.+  * darcs now supports an arbitrary number of concurrent connections when+    communicating with remote repos. See the documentation for DARCS_MGET_FOO+    in the 'Configuring Darcs' chapter in the manual for more details.++ -- David Roundy <droundy@abridgegame.org>  Wed,  8 Dec 2004 08:02:48 -0500++darcs (1.0.1rc1)++  * Fixed bug in commutation of adjacent hunks which have either no new or+    no old lines.+  * Numerous newline fixes for windows.+  * On windows, use MAPI to resolve to and from addresses.+  * Fixed problem where the --cc was ignored in apply if the patch+    succeeded.++ -- David Roundy <droundy@abridgegame.org>  Wed,  1 Dec 2004 06:24:08 -0500++darcs (1.0.1pre1)++  * Changed apply to by default refuse to apply patches that would lead to+    conflicts.+  * Removed the old darcs_cgi script, in favor of the darcs.cgi script.+  * Fixed changes to work better in partial repositories.+  * Set stdin and stdout to binary mode to fix end of line problems with+    push under windows.+  * Made send create proper MIME email.+  * Removed reportbug command, really wasn't necesary, and didn't work+    well.  Report bugs by an email to bugs@darcs.net, which creates a+    ticket in our BTS.+  * Allow darcs to work with a password protected proxy.+  * Get multiple files with a single wget call when darcs is compiled+    without libcurl support.+  * Use sftp instead of scp to copy patches via ssh -- this reuses a single+    connection for better speed.+  * Made _darcs/current polymorphic (but not really documented).+  * Made optimize --uncompress work with --partial repos.+  * Various minor interface improvements.+  * Made changes work better when specifying a file, and working in a+    partial repository.+  * Fixed bug in causing "Fail: _darcs/patches/unrevert: removeFile: does+    not exist (No such file or directory)".  Resolves bugs #57, #61.++ -- David Roundy <droundy@abridgegame.org>  Sun, 21 Nov 2004 08:29:24 -0500++darcs (1.0.0)++  * Fixed compile error when antimemoize is enabled.+  * Fixed bug that showed up when dealing with international characters in+    filenames.+  * Various documentation improvements.++ -- David Roundy <droundy@abridgegame.org>  Mon,  8 Nov 2004 06:12:08 -0500++darcs (1.0.0rc4)++  * Use autoconf to check for working install program.+  * Renamed rerecord to amend-record in a futile attempt to avoid+    confusion.+  * Made pull accept the --repodir option.+  * Fixed off-by-one error in annotate that kept users from seeing+    "deleted" version.+  * Check filesystem semantics at runtime to avoid using mmap on+    windows filesystems.+  * Fixed darcs.cgi to work properly when browsing history of renamed+    files.+  * Use anonymous file handle for temporary files in darcs.cgi -- fixes a+    temporary file leak and potentially improves security.+  * Added --summary option to commands that accept --dry-run.+  * Made pull prompt for confirmation when there is a conflict with+    unrecorded changes.+  * Made unrevert interactive.+  * Don't try to generate a new name on get if name was given explicitely.+  * Always mark conflicts, even if there's an obvious solution.+  * Quote conflict attribute values in xml output.+  * Fail if the user gives a newline in the patch name.+  * Fixed bug where new files didn't show up in darcs diff.+  * Really fix newlines in whatsnew -u.+  * Fixed bug in handling of tags in changes and annotate.+  * Fixed bug in default options containing "--".+  * Fixed various other build problems in 1.0.0rc3.+  * Fixed embarrassing failure-to-compile-on-windows bug.++ -- David Roundy <droundy@abridgegame.org>  Mon,  1 Nov 2004 05:19:01 -0500++darcs (1.0.0rc3)++  * Fixed bug leading to creation of empty "hunk" patches.+  * Fixed bug in rollback when there are pending changes.+  * Fixed push bug when default apply is --interactive.+  * Fixed a bug where "darcs pull --list-options" would try to+    complete to "home/.../darcs_repo" instead of "/home/.../darcs_repo".+  * Fixed flushing bug in darcs.cgi.+  * Fixed commutation bug with renames and file adds/removals.+  * Made --summary indicate conflicted changes.+  * Fixed generation of extra hunk in diff algorithm.+  * Added X-Mail-Originator header to emails sent by darcs.+  * Fixed a couple of bugs in the resolve command.+  * Added new cgi diff command to produce unified diff.+  * Notify when there are conflicts on push.+  * Added 'a' key to say yes to all remaining changes for interactive+    commands.+  * Automatically generate AUTHORS file from repo history.+  * Made pull --quiet actually quiet.+  * Fixed bugs in whatsnew -ls, and distinguished between manually added+    files and automatically added files.+  * Fixed bug in darcs --commands when called outside a repo.++ -- David Roundy <droundy@abridgegame.org>  Sun,  3 Oct 2004 07:45:05 -0400++darcs (1.0.0rc2)++  * Added support for comments in prefs files.+  * Added new --enable-antimemoize compile option which reduces memory+    usage at the expense of increased computational time.+  * Added a new command:  "reportbug"+  * Fixed a bug that prevented applying of a patch bundle to an+    "unoptimized" repo.+  * Fixed bug where asking for changes to a nonexistent file in a+    subdirectory would show the patch that created or renamed that+    subdirectory.+  * Improved the robustness of unrevert.  Now actions that will make+    unrevert impossible should warn the user.+  * Fixed bug when moving files or directories to the root directory of+    repo.+  * Various changes to make the --logfile way of specifying the patch name+    and comments in record more friendly:+    - Allows editing of the long comment even when --logfile is specified,+      if the --edit-long-comment option is also used.+    - When editing the long comment, the change summary is included below+      the actual text for reference, and the patch name is included in the+      first line (and thus may be modified).+    - The --logfile option is ignored if such a file doesn't exist.+    - A --delete-logfile option was added, which tells darcs to delete the+      file after doing the record.  This is intended to allow you to stick+      a --logfile=foo option in your defaults without accidentally+      recording multiple patches with the same comments because you forgot+      to modify it.+  * Fixed bug leading to .hi files in tarball.+  * Made ctrl-C work under windows, but only "pure" windows consoles, not+    in cygwin shells or mingw's rxvt (room for improvement here).+  * Fixed bug that led to curl not being tried when darcs is not compiled+    with libcurl.+  * Added an environment variable DARCS_USE_ISPRINT for people who use+    non-ascii characters in their files to indicate if the haskell standard+    library "isPrint" function works properly on their system (which+    depends on locale).+  * Reduced the number of hunks produced by the internal diff algorithm,+    when there are multiple equivalent ways of interpreting a change.+  * Made the --from-{patch,tag,match} options inclusive, and added a+    --{patch,match} option to diff (which was made easier to define by the+    inclusiveness change, since --patch x is now equivalent to+    --from-patch x --to-patch x).+  * Added support for a second argument to get, which specifies the name of+    the new directory.++ -- David Roundy <droundy@abridgegame.org>  Sun, 12 Sep 2004 06:54:45 -0400++darcs (1.0.0rc1)++  * Remove some lazy file IO which may have been causing trouble pushing in+    windows and using windows shares.+  * Various interface improvements and improved error messages.+  * Fixed bug that could cause conflicts in pending when unrecording a+    patch that contained two non-commuting non-hunk patches.+  * Fixed bug in --ask-deps option of record.+  * Added --exact-version option which gives the precise darcs context from+    which darcs was compiled.+  * MIME fixes in patch forwarding.+  * Various improvements to the darcs.cgi script.+  * Added --reverse option to changes.+  * Fixed patch numbering when file or directory arguments are given to an+    interactive command.++ -- David Roundy <droundy@abridgegame.org>  Sun, 15 Aug 2004 07:43:30 -0400++darcs (0.9.23)++  * Added a rerecord command, which will add changes to an existing+    recorded patch+  * Added support for a MOTD.+  * Vastly improved the speed and memory use of darcs optimize --checkpoint+    as well as darcs record, in the case where a record consists primarily+    of adds.++ -- David Roundy <droundy@abridgegame.org>  Mon, 26 Jul 2004 08:11:20 -0400++darcs (0.9.22)++  * add preliminary --context option to changes and get.+  * display change number, e.g. "(1/3)" in interactive commands.+  * show moves in summary format.+  * add hash of patch bundles in darcs send.+  * properly support --verbose and --quiet in add.+  * don't display binary data to screen.+  * fix bug in selecting patches by pattern.+  * fix various locking-related bugs introduced in 0.9.21.+  * fix bug when specifying logfile in a subdirectory.+  * support backslashes for directory separators in windows.+  * fix file modification time bug.++ -- David Roundy <droundy@abridgegame.org>  Sat, 26 Jun 2004 07:42:05 -0400++darcs (0.9.21)++  * made mv work even if you've already mv'ed the file or directory.+  * remember configure settings when reconfiguring.+  * added --leave-test-directory to save the directory in which the test is+    run on record or check.+  * added HTTP redirect support (thanks Benedikt).+  * fixed problems when unrecording a patch with conflits.+  * fixed locking on nfs (thanks Juliusz).+  * added preliminary version of a new cgi script for browsing darcs+    repositories (thanks to Will Glozer for contributing this).+  * add and modify a number of short flag options.+  * fix bug in applying new order patch bundles that are GPG signed.+  * fix bug in diff when a tagged version was requested.++ -- David Roundy <droundy@abridgegame.org>  Sat, 12 Jun 2004 05:39:48 -0400++darcs (0.9.20)++  * fix bug in darcs-createrepo.+  * add support for DARCS_SCP and DARCS_SSH environment variables.+  * add XML support for --summary options of changes and annotate.+  * better command-line completion on commands accepting a list of files or+    directories.+  * fix bug causing empty hunk patches to lead to failures.+  * fix bug where --all overrode file choice in record.+  * fix bug when testing patches that create subdirectories within subdirectories.+  * preserve pending changes when pulling or applying.+  * give better error message in pull when patch isn't readable.+  * allow sendEmail with no "to", just "cc" recipients.  This should fix+    the trouble with trying to --reply to a patch coming from a push rather+    than a send.++ -- David Roundy <droundy@abridgegame.org>  Wed,  5 May 2004 06:01:48 -0400++darcs (0.9.19)++  * fix bugs leading to failures in the wxhaskell interface.+  * fix bug that caused darcs diff to fail.+  * fixed bug in get that lead to _darcs/current/_darcs directories.+  * improved error reporting in several situations.+  * fixed bug when pulling or pushing into an empty repo.+  * added --summary option to changes to summarize the changes made in each+    patch.++ -- David Roundy <droundy@abridgegame.org>  Fri,  9 Apr 2004 07:19:34 -0400++darcs (0.9.18)++  * added support for sending email from windows using the MAPI interface.+    This code attaches the patch bundle in base64-encoded form, which darcs+    can't currently decode (expect that in the next release), but the patch+    bundle can be manually applied if a mail program does the decoding.+  * renamed "darcs push" to "darcs send" and added a new "darcs push"+    command roughly equivalent to the old "darcs push --and-apply".+  * removed support for setting up a test suite by simple creating a file+    named "darcs_test".  You now should use setpref to define the test+    suite command.+  * fixed some problems when working in a --partial repository.+  * lots of code was cleaned up.  We have enabled the -Wall compiler flag+    and are in the process of eliminating all the warnings.  This should+    make the code more friendly to new developers, and also helps with the+    next bullet point:+  * improved handling of errors--informative failure messages are more+    likely than they were before.+  * by default only check changes made since last checkpoint--this greatly+    speeds up check.+  * add --quiet option.  Some commands don't yet support this.  If+    there's a command you want to quiet down, let us know.+  * several performance enhancements: improved SHA1 performance, faster+    check and get on repositories with a long history and improved+    performance with very large files.++ -- David Roundy <droundy@abridgegame.org>  Thu,  1 Apr 2004 05:43:18 -0500++darcs (0.9.17)++  * fixed bug in darcs apply that made the --no-test option fail.+  * fixed bug that caused darcs to set file permissions to be+    non-world-readable.+  * darcs record and whatsnew can now accept file or directory arguments+    and limit their actions to changes in those files or directories.+  * darcs changes now can accept file or directory arguments and limit+    itself to changes affecting those files or directories.++ -- David Roundy <droundy@abridgegame.org>  Sat, 21 Feb 2004 08:12:34 -0500++darcs (0.9.16)++  * Add --sign-as=KEYID option to push command.+  * make optimize split up inventory for faster pulls+  * Allow use of a different make command for tests, such as gmake+  * Can now put prefs that would normally go in _darcs/prefs (defaults,+    binaries and boring) in ~/.darcs/ to set the prefs for all your+    repositories at once.+  * add primitive xml output to annotate of directory.+  * When pushing a patch, add the list of changes in the description.+  * refuse to rollback a patch twice, since that would cause problems.+  * make darcs diff accept optional arguments indicating files and+    directories to diff.+  * preserve permissions on files in working directory.+  * put docs in ...share/doc/darcs not share/darcs/doc.+  * add support for multiple-choice options.  This means that you can now+    set your default option in _darcs/prefs/defaults, and then override+    that default on the command line.+  * shortened --use-external-merge-tool option to --external-merge+  * more "boring" patterns.++ -- David Roundy <droundy@abridgegame.org>  Tue, 10 Feb 2004 07:08:14 -0500++darcs (0.9.15)++  * next step repository format transition--we use the new patch filenames.+  * fix handling of text files with no trailing newline--this will cause+    some trouble.  Darcs will require that you convert your repository+    using convert-repo.  This will leave you with a bunch of changes+    regarding trailing newlines which you will either want to record or+    revert.+  * the windows support is somewhat improved.+  * added simple "repair" command that can repair some kinds of+    inconsistencies in the repository.+  * added primitive "annotate" command to extract information about+    modifications to files and directories.+  * fixed handling of darcs mv to allow moving to directories in a more+    intuitive manner.+  * handling of binary files was dramatically improved in both memory and+    cpu usage.+  * added autoconf testing framework to clean up code dealing with+    different versions of ghc, features that don't exist on windows, bugs+    that only exist on windows, etc.+  * don't accept invalid flags.+  * add more patterns to boring and binary.+  * use autoconf test to handle posix signals and windows '\\' handling.+  * switch to using new patch filenames.+  * XML formatted output for 'changes' command+  * add support for unidiff-like whatsnew output.+  * fix bug in RTS memory calculation for large RAM size+  * add rollback command.+  * improve checkpointing support.+  * add diff-opts option to darcs diff.+  * add support for building docs using htlatex or hevea rather than+    latex2html.+  * use locking whereever it is needed.+  * add safe (atomic) writing of inventory files.++ -- David Roundy <droundy@abridgegame.org>  Fri, 12 Dec 2003 07:59:54 -0500++darcs (0.9.14)++  * darcs changes now shows times formatted according to current locale.+  * add support for automatically treating files containing ^Z or '\0' as+    binary.+  * add experimental checkpointing, allowing get to only download the+    recent change history.+  * allow darcs to be called within subdirectories of a repository.+  * make default be to compress patches.+  * add --summary option to whatsnew.+  * add trackdown command.+  * fix bug in darcs dist --verbose.+  * make darcs diff have closer behavior to cvs diff.  In particular, darcs+    diff with no arguments now gives you the difference between the working+    directory and the latest recorded version.+  * support external graphical merge tools.+  * fix bug where binary patch is created even with no change.+  * support darcs -v for version.  Also mention the darcs version in the+    usage mesage.+  * ignore empty lines in boring file and binary file.+  * preserve pending changes (e.g. file adds or darcs replaces) across+    revert and record.+  * create repositories with new patch filename format.+    The new repo format is now created alongside the old format, but the+    old format is read.  There is a tool called convert-repo that will+    convert an old format repo to have both formats.+  * use iso format for dates in record.+  * New patch-selecting interface.+    This patch only uses the new routine for revert, since it's not+    particularly well tested.  The text method now allows one to go back+    and edit previous patches.  The idea is that eventually all commands+    that need the user to select a subset of patches will use this routine.+  * use hash for cgi cache file names.+  * add preliminary experimental GUI support using wxhaskell.+  * remember author name after first record in a repo.+  * add unrevert command.+  * always match full pathnames when checking boringness or binaryness.+  * rewrite replace tokenizer for more speed.+  * make darcs compile with ghc 6.2 and later.+  * fix some bugs in darcs diff.+  * make --and-apply work locally as well as via ssh.+    Also added a --and-apply-as that uses sudo to run the apply command as+    a different user.++ -- David Roundy <droundy@abridgegame.org>  Mon, 10 Nov 2003 07:08:20 -0500++darcs (0.9.13)++  * Various performance enhancements.+  * add --pipe option to tag and record, which causes them to prompt for+    all their input, including date.  This can be useful when creating+    repository converters.+  * remove '-t' short command line option for '--to' and the '-o' short+    option for '--reponame'.+  * remove the darcs-patcher program.+        The functionality of the darcs-patcher program is taken over by+        the darcs apply command.  Several fancy features have been added,+        as described in the Apply section of the manual.+  * support spaces and (maybe) unicode in filenames.+  * updates to win32 support+  * push via ssh+  * add --without-libcurl option to configure+  * include DarcsURL in push email.+  * add support for reading and writing gzipped patch files.+  * allow multiple --to addresses on push, and also support --cc for+    additional addresses.+  * when pulling or pushing from lastrepo, say where lastrepo is.+  * only save lastrepo in get if the source repo wasn't a relative+    directory path.++ -- David Roundy <droundy@abridgegame.org>++darcs (0.9.12)++  * add manual section on building darcs.+  * improve scaling of checking for and resolving conflicts, which was an+    O(n^2) function.+  * escape ESC char when printing patches.+  * don't reorder patches unless necesary--this avoids an O(n^2) operation+    which was making a darcs record very slow when a lot of files were+    added.+  * fix default regexps for boring file (Thanks Trevor!)+  * replace now ignores files that aren't in the repo.+  * make darcs add refuse to add files whose subdirectories don't exist.+  * implement support for binary files.+  * added support for running external programs to fetch files.+  * fix conflict resolution bug from 0.9.11.+  * make the patcher run the test prior to applying.+  * add repo locking.+  * Fix bug when pulling from a repo containing just one patch (thanks+    Peter).+  * install cgi script in cgi-bin directory.++ -- David Roundy <droundy@abridgegame.org>++darcs (0.9.11)++  * A rewrite of the configure code and makefile (thanks to Peter Simons).+  * Added several new repository configuration options including a setpref+    command which allows you to set preferences options that are pulled+    from repo to repo.+  * Yet another rewrite of the merging code.+  * User can now revert changes on a change-by-change basis.+  * Yet another major improvement in speed and memory consumption.+  * Add a darcs diff command to compare two versions.++ -- David Roundy <droundy@abridgegame.org>  Mon, 30 Jun 2003 06:42:10 -0400++darcs (0.9.10)++  * Added a way to configure the default values for options to darcs+    commands.  See Appendix B of manual.+  * darcs push and pull now default to pulling and pushing from the most+    recently accessed repository (if you don't specify a repo).+  * Numerous bugfixes.++ -- David Roundy <droundy@abridgegame.org>  Wed, 21 May 2003 07:08:40 -0400++darcs (0.9.9)++  * Created a way to have a "centralized server".  (See darcs-patcher+    chapter in manual).+  * Added new darcs-server package.+  * Switch to new repository format.  Note that your repo will only be+    converted to the new format if you use certain commands such as+    unpull.  You can recognize the new format by the presence of a+    _darcs/inventories/ directory.+  * Add the ability to sign patches sent with push using gnupg and to+    verify those signatures when applying.  (This is the authentication+    basis for the above-mentioned server).+  * Fix bug in application of a file rename patch.++ -- David Roundy <droundy@abridgegame.org>  Thu,  8 May 2003 06:58:42 -0400++darcs (0.9.8)++  * Fix rare bug in check when files happen to be a multiple of 1024 bytes+    in length.+  * Fix bug in reading patch ids with long comments from local files.+  * Prepare for a change in the repository format.  The format doesn't+    change for this version, but version 0.9.8 is able to read the new+    repository format.++ -- David Roundy <droundy@abridgegame.org>  Wed, 30 Apr 2003 08:54:18 -0400++darcs (0.9.7)++  * Fix a couple of rename conflict bugs.+  * Add new test suite framework, along with several tests.+  * Several major optimizations for speed and memory.+  * Added --ignore-times option to not assume that when a file+    modification time hasn't changed the file itself hasn't changed.++ -- David Roundy <droundy@abridgegame.org>  Sat, 26 Apr 2003 07:57:01 -0400++darcs (0.9.6)++  * Fixed a couple of bugs in the merging of conflicting renames.+  * Added an interface to include long comments when recording.+  * Improve the interface of pull, allowing for viewing the patches before+    pulling them.+  * Include zsh command completion examples with docs.+  * Massively improved responsiveness in command completion.+  * Use packed strings to save memory.+  * Fixed a bug that shows up in empty repos.+  * Fixed multiple bugs in the mv command.++ -- David Roundy <droundy@abridgegame.org>  Thu, 17 Apr 2003 09:34:34 -0400++darcs (0.9.5)++  * Improve merge of creation of files and directories with the same name.+  * Add darcs push and apply commands, which are the beginning of work+    towards supporting a "centralized server" concept a la CVS.  However,+    they are also useful for a "Linus" style workflow, based on emailing+    patches.  In theory they could also be used to provide a smart server+    that could server pulls using less bandwidth.+  * Add an unpull command analagous to unrecord, but which removes the+    patches from the working directory also.+  * Enable the mv command, since the mv patches have now been supported by+    a couple of versions.+  * Include zsh_completion code, thanks to Aaron Denney <wnoise@ofb.net>.++ -- David Roundy <droundy@abridgegame.org>  Wed,  9 Apr 2003 07:52:01 -0400++darcs (0.9.4)++  * Speed up whatsnew and record in the case where there are huge numbers+    of extra files in the working directory.+  * Small (~10%) speedup in get.++ -- David Roundy <droundy@abridgegame.org>  Fri,  4 Apr 2003 09:08:38 -0500++darcs (0.9.3)++  * Optimized whatsnew and record by seting modification time of "current"+    files equal to that of working files if they are identical, so I won't+    have to check again if the working one hasn't been changed.+  * Rewrite file renaming code (no creation).+  * Add support for replacing tokens in files.+  * Make cgi output work more accurately, and point out which files were+    modified by each patch.+  * Add a caching feature to the cgi script to speed things up a bit.+  * Turn on creation of dependencies when recording.+  * Add a 'tag' command.+  * Rewrote the 'pull' code to hopefully speed it up (and in any case to+    greatly simplify it).++ -- David Roundy <droundy@abridgegame.org>  Thu,  3 Apr 2003 07:08:05 -0500++darcs (0.9.2)++  * Add build dependency on tetex and latex2html+  * Have internal diff code properly respond to deleted files and+    directories.+  * Create file and directory rename patch types. (no creation--which+    means that I am waiting to create commands to create such patches+    until later, to avoid backward compatibility issues of repos.)+  * Add support for patch dependencies. (no creation)+  * Add support for token replacement patches. (no creation)++ -- David Roundy <droundy@abridgegame.org>  Thu, 27 Mar 2003 07:59:09 -0500++darcs (0.9.1)++  * Make darcs get --verbose actually be verbose (which is important+    because it takes so long that the user might be afraid it's hanging.+  * Speed up the merge in complicated cases, possibly dramatically.+  * Add a darcs remove command.++ -- David Roundy <droundy@abridgegame.org>  Mon, 10 Mar 2003 09:48:55 -0500++darcs 0.9.0++  * Initial Release.++ -- David Roundy <droundy@abridgegame.org>  Wed,  3 Mar 2003 13:51:58 -0500++++Local variables:+mode: outline+outline-regexp: "[dD]\\| +\\*+"+paragraph-separate: "[  ]*$"+end:
README view
@@ -11,35 +11,27 @@ Compilation and Installation ============================ -Darcs currently supports two build systems: a traditional autotools--based system, and an experimental cabal-based system.  Currently-AUTOTOOLS IS RECOMMENDED; in later releases it will be deprecated and-eventually removed (in favour of cabal).+Darcs currently supports two build systems: a cabal-based system and a legacy+autotools-based system, and a cabal-based system. CABAL IS RECOMMENDED and the+autotools system is deprecated: in future releases, autotools support will be+removed.  If a "configure" file is present, autotools is supported.  If a "Setup.lhs" file is present, cabal is supported.  Currently there is a separate source tarball for each build system; either can be used in unstable checkouts. --Using Autotools------------------If you have the normal, autotools-based tarball, this sequence should work-for you (if you are in doubt, this is likely the case):--    $ ./configure-    $ make-    # make install--You first need to run `autoconf` if you obtained the source tree from the-darcs repository (but this is not needed for release tarballs).--For more information, please see the manual:-- * http://www.darcs.net/manual- * doc/manual/darcs.ps-+Using GHC 6.10.3 or newer is STRONGLY RECOMMENDED. You can compile darcs with+GHC 6.8, but there are several caveats. If you are using 6.8.2 or older, please+disable mmap support (pass -f-mmap to cabal install or runghc Setup configure+below). Note that the GHC 6.8.2 that ships with Debian Lenny is not affected+and it should be safe to keep mmap enabled. It is also recommended to disable+use of Hackage zlib when compiling with GHC 6.8.2 (including the Debian Lenny+version): pass -f-zlib to cabal. When using zlib, we have seen occasional+crashes with error messages like "openBinaryFile: file locked" -- this is a+known GHC 6.8.2 bug (and is fixed in GHC 6.8.3). Last, if you are using a+64-bit system, darcs may hang when you exit a pager when compiled with GHC+older than 6.10.3. Although this is harmless, it is quite inconvenient.  Using Cabal -----------@@ -47,12 +39,11 @@ This method requires the cabal package, version 1.6 or higher.  The cabal-install package is also recommended. -If you have the "cabal-install" package on your system (that is, there-is a "cabal" executable in your path), you can use the following-commands to create an executable in ~/.cabal/bin/darcs.+If you have the "cabal-install" package on your system (that is, there is a+"cabal" executable in your path), you can use the following command to create+an executable in ~/.cabal/bin/darcs (this will also automatically fetch and+build dependencies from the Hackage server). -    $ cabal configure-    $ cabal build     $ cabal install  Otherwise, if you have the "cabal" package but not the "cabal-install"@@ -73,10 +64,29 @@ library (and development headers). If, for some reason, you cannot provide cURL, please pass "-f-curl" to the configure step above. +Using Autotools+---------------++If you have the normal, autotools-based tarball, this sequence should work+for you (if you are in doubt, this is likely the case):++    $ ./configure+    $ make+    # make install++You first need to run `autoconf` if you obtained the source tree from the+darcs repository (but this is not needed for release tarballs).++For more information, please see the manual:++ * http://www.darcs.net/manual+ * doc/manual/darcs.ps++ Hacking ======= For more information about darcs hacking and best practices please check-the darcs wiki at http://darcs.net/DarcsWiki+the darcs wiki at http://wiki.darcs.net/DarcsWiki  Of particular interest are the following documents:   * http://wiki.darcs.net/index.html/DeveloperFAQ
Setup.lhs view
@@ -6,47 +6,45 @@ import Distribution.Simple          ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.PackageDescription-         ( PackageDescription(executables), Executable(buildInfo)+         ( PackageDescription(executables), Executable(buildInfo, exeName)          , BuildInfo(customFieldsBI), emptyBuildInfo-         , updatePackageDescription )+         , updatePackageDescription, cppOptions, ccOptions ) import Distribution.Package          ( packageVersion )-import Distribution.Simple.Program-         ( Program(..), simpleProgram, findProgramVersion-         , rawSystemProgramStdoutConf )-import Distribution.Simple.Configure-         ( ccLdOptionsBuildInfo ) import Distribution.Version-         ( Version(versionTags) )+         ( Version(versionBranch) ) import Distribution.Simple.LocalBuildInfo-         ( LocalBuildInfo(..) )-+         ( LocalBuildInfo(..), absoluteInstallDirs )+import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest)) import Distribution.Simple.Setup-         ( configVerbosity, buildVerbosity, sDistVerbosity, fromFlag )+    (buildVerbosity, copyDest, copyVerbosity, fromFlag,+     haddockVerbosity, installVerbosity, sDistVerbosity) import Distribution.Simple.BuildPaths          ( autogenModulesDir ) import Distribution.System          ( OS(Windows), buildOS ) import Distribution.Simple.Utils-         ( rewriteFile, rawSystemStdout, createDirectoryIfMissingVerbose-         , withFileContents, notice )+    (copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout,+     rewriteFile) import Distribution.Verbosity          ( Verbosity ) import Distribution.Text          ( display )+import Distribution.Package (Package) -import Control.Monad ( zipWithM_, when )-import Control.Exception ( bracket, bracket_ )-import System.Directory( doesDirectoryExist, doesFileExist,-                         getDirectoryContents, createDirectory,-                         copyFile, removeDirectoryRecursive,-                         getCurrentDirectory, setCurrentDirectory,-                         removeFile, createDirectoryIfMissing )+import Control.Monad ( zipWithM_, when, unless, filterM )+import Control.Exception ( bracket )+import System.Directory+    (copyFile, createDirectory, createDirectoryIfMissing,+     doesDirectoryExist, doesFileExist,+     getCurrentDirectory, getDirectoryContents,+     removeDirectoryRecursive, removeFile, setCurrentDirectory)+import System.IO (openFile, IOMode (..))+import System.Process (runProcess) import System.IO.Error ( isDoesNotExistError )-import Data.List( isSuffixOf )-import System( system, ExitCode(..) )+import Data.List( isSuffixOf, sort, partition ) -import System.FilePath       ( (</>) )+import System.FilePath       ( (</>), splitDirectories, isAbsolute ) import Foreign.Marshal.Utils ( with ) import Foreign.Storable      ( peek ) import Foreign.Ptr           ( castPtr )@@ -60,40 +58,38 @@ import qualified Control.Exception as Exception #endif +main :: IO () main = defaultMainWithHooks simpleUserHooks { -  hookedPrograms = [libwwwconfigProgram],-  -  confHook = \(pkg0, pbi) flags -> do-    let verbosity = fromFlag (configVerbosity flags)--    -- Call the ordinary build code-    lbi <- confHook simpleUserHooks (pkg0, pbi) flags+  buildHook = \ pkg lbi hooks flags ->+              let verb = fromFlag $ buildVerbosity flags+               in commonBuildHook buildHook pkg lbi hooks verb >>= ($ flags), -    -- Do some custom stuff:-    let pkg = localPkgDescr lbi-    libwwwBi <- getLibwwwBuildInfo verbosity pkg lbi-    let hbi  = (Nothing, [("darcs", libwwwBi)])-        lbi' = lbi { localPkgDescr = updatePackageDescription hbi pkg } -    generateAutoconfModule verbosity pkg lbi-    return lbi',+  haddockHook = \ pkg lbi hooks flags ->+                let verb = fromFlag $ haddockVerbosity flags+                 in commonBuildHook haddockHook pkg lbi hooks verb >>= ($ flags) , -  buildHook = \pkg lbi hooks flags -> do-    let verbosity = fromFlag (buildVerbosity flags)-    -    -- Do some custom stuff:-    writeGeneratedModules verbosity pkg lbi-    -    -- Call the ordinary build code-    buildHook simpleUserHooks pkg lbi hooks flags,+  postBuild = \ _ _ _ lbi -> buildManpage lbi,+  postCopy = \ _ flags pkg lbi ->+             installManpage pkg lbi (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags),+  postInst = \ _ flags pkg lbi ->+             installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest, -  runTests = \ args _ _ _ ->+  runTests = \ args _ _ lbi -> do+             cwd <- getCurrentDirectory+             let isabs = isAbsolute $ buildDir lbi+                 path = (if isabs then id else (cwd </>))+                        (buildDir lbi </> "darcs")+                 what = if null args then ["tests"] else args+                 (series, tests) = partition+                                     (`elem` ["bugs", "network", "tests"]) what              sequence_ [ case w of-                           x | x == "bugs" -> allTests Bug-                             | x == "network" -> execTests Network ""-                             | x == "tests" -> allTests Test-                             | otherwise -> fail $ "Unknown test: " ++ x-                         | w <- if null args then ["tests"] else args ],+                           "bugs" -> allTests path Bug []+                           "network" -> execTests path Network "" []+                           "tests" -> allTests path Test []+                           _ -> return () {- impossible, silence -Wall -}+                         | w <- series ]+             when (not $ null tests) $ individualTests path tests,    -- Remove the temporary directories created by "cabal test".   postClean = \ _ _ _ _ -> mapM_ rmRf@@ -116,100 +112,90 @@     sDistHook simpleUserHooks pkg lbi hooks flags } -libwwwconfigProgram :: Program-libwwwconfigProgram = (simpleProgram "libwww-config") {-    programFindVersion = findProgramVersion "--version" id-  }+-- | For @./Setup build@ and @./Setup haddock@, do some unusual+-- things, then invoke the base behaviour ("simple hook").+commonBuildHook :: (UserHooks -> PackageDescription -> LocalBuildInfo -> t -> a)+                -> PackageDescription -> LocalBuildInfo -> t -> Verbosity -> IO a+commonBuildHook runHook pkg lbi hooks verbosity = do+  -- Autoconf may have generated a context file.  Remove it before+  -- building, as its existence inexplicably breaks Cabal.+  removeFile "src/Context.hs"+    `catch` (\e -> unless (isDoesNotExistError e) (ioError e)) -getLibwwwBuildInfo verbosity pkg lbi-  | "x-have-libwww" `elem` customFields = do-    cflags <- libwwwconfig ["--cflags"]-    libs   <- libwwwconfig ["--libs"]-    return (ccLdOptionsBuildInfo (words cflags) (words libs))+  -- Create our own context file.+  writeGeneratedModules verbosity pkg lbi -  | otherwise = return emptyBuildInfo+  -- Add custom -DFOO[=BAR] flags to the cpp (for .hs) and cc (for .c)+  -- invocations, doing a dance to make the base hook aware of them.+  (version, state) <- determineVersion verbosity pkg+  littleEndian <- testEndianness+  let args = ("-DPACKAGE_VERSION=" ++ show' version) :+             ("-DPACKAGE_VERSION_STATE=" ++ show' state) :+             [arg | (arg, True) <-         -- include fst iff snd.+              [("-DHAVE_HTTP", "x-have-http" `elem` customFields),+               ("-DUSE_COLOR", "x-use-color" `elem` customFields),+               -- We have MAPI iff building on/for Windows.+               ("-DHAVE_MAPI", buildOS == Windows),+               ("-DBIGENDIAN", not littleEndian)]]+      bi = emptyBuildInfo { cppOptions = args, ccOptions = args }+      hbi = (Just bi, [(exeName exe, bi) | exe <- executables pkg])+      pkg' = updatePackageDescription hbi pkg+      lbi' = lbi { localPkgDescr = pkg' }+  return $ runHook simpleUserHooks pkg' lbi' hooks    where-    libwwwconfig = rawSystemProgramStdoutConf verbosity-                     libwwwconfigProgram (withPrograms lbi)     customFields = map fst . customFieldsBI . buildInfo $ darcsExe-    [darcsExe]   = executables pkg--generateAutoconfModule verbosity pkg lbi = do-  bigendian <- fmap not archIsLittleEndian--  let subst "configure_input" = targetFile ++ ". Generated from "-                                  ++ templateFile ++ " by Setup.hs."-      subst "HAVE_HTTP"     = show ("x-have-http" `elem` customFields)-      subst "USE_COLOR"     = show ("x-use-color" `elem` customFields)-      subst "USE_MMAP"     -                | isWindows = show False-                | otherwise = show True-      subst "HAVE_SENDMAIL" = show True-      subst "SENDMAIL"      = "/usr/sbin/sendmail"-      subst "HAVE_MAPI"-                | isWindows = show True-                | otherwise = show False-      subst "DIFF"          = "diff"-      subst "BIGENDIAN"     = show bigendian-      subst other           = unexpected other--  createDirectoryIfMissingVerbose verbosity True targetDir-  withFileContents templateFile-    (rewriteFile targetFile . templateSubstitute subst)+    darcsExe = head [e | e <- executables pkg, exeName e == "darcs"]+    show' :: String -> String   -- Petr was worried that we might+    show' = show                -- allow non-String arguments.+    testEndianness :: IO Bool+    testEndianness = with (1 :: Word32) $ \p -> do o <- peek $ castPtr p+                                                   return $ o == (1 :: Word8) -  where-    templateFile = "src/Autoconf.hs.in"-    targetDir    = autogenModulesDir lbi-    targetFile   = targetDir </> "Autoconf.hs"-    unexpected other = error $ "unexpected variable in template file "-                            ++ templateFile ++ ": " ++ show other-    isWindows    = case Distribution.System.buildOS of-                     Windows -> True-                     _       -> False-    customFields = map fst . customFieldsBI . buildInfo $ darcsExe-    [darcsExe]   = executables pkg+buildManpage :: LocalBuildInfo -> IO ()+buildManpage lbi = do+  let darcs = buildDir lbi </> "darcs/darcs"+      manpage = buildDir lbi </> "darcs/darcs.1"+  manpageHandle <- openFile manpage WriteMode+  runProcess darcs ["help","manpage"]+             Nothing Nothing Nothing (Just manpageHandle) Nothing+  return () -archIsLittleEndian :: IO Bool-archIsLittleEndian =-  with (1 :: Word32) $ \p -> do o <- peek $ castPtr p-                                return $ o == (1 :: Word8)+installManpage :: PackageDescription -> LocalBuildInfo+                  -> Verbosity -> CopyDest -> IO ()+installManpage pkg lbi verbosity copy =+    copyFiles verbosity+              (mandir (absoluteInstallDirs pkg lbi copy) </> "man1")+              [(buildDir lbi </> "darcs", "darcs.1")]  writeGeneratedModules :: Verbosity                       -> PackageDescription -> LocalBuildInfo -> IO () writeGeneratedModules verbosity pkg lbi = do   createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi) -  let versionModulePath = autogenModulesDir lbi </> "ThisVersion.hs"-  generateVersionModule verbosity versionModulePath pkg-   let contextModulePath = autogenModulesDir lbi </> "Context.hs"   generateContextModule verbosity contextModulePath pkg -generateVersionModule verbosity targetFile pkg = do+determineVersion :: Verbosity -> PackageDescription -> IO (String, String)+determineVersion verbosity pkg = do   let darcsVersion  =  packageVersion pkg   numPatches <- versionPatches verbosity darcsVersion-  let darcsVersionState = versionStateString numPatches darcsVersion-      subst "DARCS_VERSION"       = display darcsVersion-      subst "DARCS_VERSION_STATE" = darcsVersionState-      subst other                 = unexpected other-  -  withFileContents templateFile-    (rewriteFile targetFile . templateSubstitute subst)-      +  return (display darcsVersion, versionStateString numPatches darcsVersion)+   where     versionStateString :: Maybe Int -> Version -> String-    versionStateString Nothing  _ = "unknown" -    versionStateString (Just 0) v = case versionTags v of-                         ["pre"] -> "prerelease"-                         ["rc"]  -> "release candidate"-                         []      -> "release"-                         _       -> "tag"+    versionStateString Nothing  _ = "unknown"+    versionStateString (Just 0) v = case versionBranch v of+                         x | 97 `elem` x -> "alpha " ++ show (after 97 x)+                           | 98 `elem` x -> "beta " ++ show (after 98 x)+                           | 99 `elem` x  ->+                               "release candidate " ++ show (after 99 x)+                         _ -> "release"     versionStateString (Just 1) _ = "+ 1 patch"     versionStateString (Just n) _ = "+ " ++ show n ++ " patches"-    templateFile = "src/ThisVersion.hs.in"-    unexpected other = error $ "unexpected variable in template file "-                            ++ templateFile ++ ": " ++ show other+    after w (x:r) | w == x = head r+                  | otherwise = after w r+    after _ [] = undefined  versionPatches :: Verbosity -> Version -> IO (Maybe Int) versionPatches verbosity darcsVersion = do@@ -230,6 +216,7 @@  where   versionFile = "release/distributed-version" +generateContextModule :: (Package pkg) => Verbosity -> FilePath -> pkg -> IO () generateContextModule verbosity targetFile pkg = do   ctx <- context verbosity (packageVersion pkg)   rewriteFile targetFile $ unlines@@ -281,55 +268,65 @@     show Test = "tests"     show Network = "tests/network" +flat :: (Show a) => a -> String flat a = [ if x == '/' then '_' else x | x <- show a ] -harness :: String-harness = "perl ../tests/shell_harness"- isTest :: FilePath -> Bool isTest = (".sh" `isSuffixOf`) -execTests' :: TestKind -> IO ()-execTests' k =-    do fs <- getDirectoryContents "."-       cwd <- getCurrentDirectory-       let run = filter isTest fs-       res <- Harness.runTests cwd run-       when ((not res) && (k /= Bug)) $ fail "Tests failed"-       return ()--execTests :: TestKind -> String -> IO ()-execTests k fmt = do-  copyFile "dist/build/darcs/darcs" "darcs"+execTests :: FilePath -> TestKind -> String -> [String] -> IO ()+execTests darcs_path k fmt tests = do   let dir = (flat k) ++ "-" ++ fmt ++ ".dir"   rmRf dir   cloneTree (show k) dir   withCurrentDirectory dir $ do     createDirectory ".darcs"     when (not $ null fmt) $ appendFile ".darcs/defaults" $ "ALL " ++ fmt ++ "\n"-    execTests' k+    putStrLn $ "Running tests for format: " ++ fmt+    exec+ where exec = do+         fs <- case tests of+                  [] -> sort `fmap` getDirectoryContents "."+                  x -> return x+         cwd <- getCurrentDirectory+         let run = filter isTest fs+         res <- Harness.runTests (Just darcs_path) cwd run+         when ((not res) && (k /= Bug)) $ fail "Tests failed"+         return () -allTests :: TestKind -> IO ()-allTests k =+individualTests :: FilePath -> [String] -> IO ()+individualTests darcs_path tests = do+  run <- concat `fmap` mapM find tests+  sequence_ [ do exec kind [test | (kind', test) <- run, kind' == kind]+                     | kind <- [Test, Bug, Network] ]+      where tryin w t' = [w </> t', w </> (t' ++ ".sh")]+            exec _ [] = return ()+            exec kind to_run = allTests darcs_path kind to_run+            find t = do+              let c = [t, t ++ ".sh"] ++ tryin "tests" t ++ tryin "bugs" t+                        ++ tryin "network" t+              run <- map kindify `fmap` filterM doesFileExist c+              return $ take 1 run+            kindify test = case splitDirectories test of+                             [p, y] -> (parse_kind p, y)+                             _ -> error $ "Bad format in " ++ test +++                                          ": expected type/test"+            parse_kind "tests" = Test+            parse_kind "bugs" = Bug+            parse_kind "network" = Network+            parse_kind x = error $ "Test prefix must be one of " +++                           "[tests, bugs, network] in " ++ x+++allTests :: FilePath -> TestKind -> [String] -> IO ()+allTests darcs_path k s =     do test `mapM` repotypes        return ()     where repotypes = ["darcs-2", "hashed", "old-fashioned-inventory"]-          test = execTests k--------------------------- Utility functions-----templateSubstitute :: (String -> String) -> String -> String-templateSubstitute varSubst = subst-  where-    subst text = case span (/= '@') text of-      (chunk, []) -> chunk-      (chunk, '@':rest) -> case span (/= '@') rest of-        (var, '@':rest) -> chunk ++ varSubst var ++ subst rest+          test x = execTests darcs_path k x s  ---------------------------------------------------------- More utility functions (FIXME)+-- Utility functions (FIXME) -- copy & paste & edit: darcs wants to share these -- @@ -379,6 +376,7 @@ cloneFile :: FilePath -> FilePath -> IO () cloneFile = copyFile +rmRf :: FilePath -> IO () rmRf path = do   isdir <- doesDirectoryExist path   isf <- doesFileExist path
bugs/add_permissions.sh view
@@ -1,23 +1,36 @@ #!/usr/bin/env bash-set -ev--# add should fail on files it can't read (because it would fail to record it later anyway)--if echo $OS | grep -i windows; then-  echo This test does not work on Windows-  exit 0-fi+## Darcs should refuse to add an unreadable file, because unreadable+## files aren't recordable.+##+## Copyright (C) 2005  Mark Stosberg+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE. -rm -rf temp1-mkdir temp1-cd temp1-darcs init-touch no_perms.txt-chmod 0000 no_perms.txt-# surely there is an easier way to write this 'not'-# i'm think of the 'finally' in try/catch/finally-dacrs add no_perms.txt 2> log && (chmod 0755 no_perms.txt ; exit 1) || chmod 0755 no_perms.txt -grep -i 'permission denied' log+. ../tests/lib -cd ..+abort_windows                   # does not work on Windows.+rm -rf temp1                    # Another script may have left a mess.+darcs initialize --repodir temp1+touch temp1/unreadable+chmod a-r temp1/unreadable      # Make the file unreadable.+not darcs add --repodir temp1 no_perms.txt 2>temp1/log+fgrep -i 'permission denied' temp1/log rm -rf temp1
− bugs/bin/darcs 
@@ -1,10 +0,0 @@-#!/bin/sh--if test "x$1" = "x--am-I-the-test-wrapper"-then-    echo "Yes, I am the test wrapper"-    exit 0-fi--test $DARCS || DARCS=$HOME/../darcs-$DARCS "$@"
+ bugs/emailformat.sh view
@@ -0,0 +1,46 @@+#!/usr/bin/env bash++# This appears to hang on Windows++set -ev+# TODO: is this really enough to make all commands interpret the given strings +# as latin1?+export LANG="en_US.ISO-8859-1"++rm -rf temp1+rm -rf temp2+mkdir temp1+mkdir temp2+cd temp1++seventysevenaddy="<aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@bbbbbbbbbb.cccccccccc.abrasoft.com>"++darcs init++echo "Have you seen the smørrebrød of René Çavésant?" > non_ascii_file+darcs add non_ascii_file+darcs record -am "non-ascii file add" -A test++cd ../temp2+darcs init+cd ../temp1++# long email adress: check that email adresses of <= 77 chars don't get split up+darcs send --from="Kjålt Überström $seventysevenaddy" \+           --subject "Un patch pour le répositoire" \+           --to="Un garçon français <garcon@francais.fr>" \+           --sendmail-command='cp /dev/stdin mail_as_file %<' \+           -a ../temp2++cat mail_as_file+# The long mail address should be in there as a whole+grep $seventysevenaddy mail_as_file++# Check that there are no non-ASCII characters in the mail+ghc -e 'getContents >>= return . not . any (> Data.Char.chr 127)' < mail_as_file | grep '^True$'+++cd ..+rm -rf temp1+rm -rf temp2+
− bugs/issue1162_add_nonexistent_slash.sh 
@@ -1,16 +0,0 @@-#!/bin/sh--set -ev--not () { "$@" && exit 1 || :; }--rm -rf temp-mkdir temp-cd temp-darcs init-not darcs add a/ 2> err-cat err-grep 'does not exist (No such file or directory)' err-cd ..--rm -rf temp
+ bugs/issue1190_unmarked_hunk_replace_conflict.sh view
@@ -0,0 +1,43 @@+#!/usr/bin/env bash+## Test for issue1190 - conflicts between HUNK and REPLACE are not+## marked by --mark-conflicts.+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib++rm -rf d e                      # Another script may have left a mess.+darcs init    --repo d/+printf %s\\n foo bar baz >d/f+darcs record  --repo d/ -lam f1+darcs get d/ e/+darcs replace --repo e/ --force bar baz f+darcs record  --repo e/ -lam replacement+printf %s\\n foo bar quux >d/f  # replace baz with quux+darcs record  --repo d/ -am f2++## There ought to be a conflict here, and there is.+darcs pull    --repo e/ d/ -a --mark-conflicts+## The file ought to now have conflict markers in it.+grep 'v v v' e/f+rm -rf d/ e/                    # Clean up after ourselves.
+ bugs/issue1266_init_inside_a_repo.sh view
@@ -0,0 +1,33 @@+#!/usr/bin/env bash+## Test for issue1266 - attempting to initialize a repository inside+## another repository should cause a warning, because while perfectly+## legitimate, it is likely to be accidental.+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib++rm -rf temp1 out                # Another script may have left a mess.+darcs init --repodir temp1+darcs init --repodir temp1/temp2 2>&1 | tee out+grep -i WARNING out             # A warning should be printed.
+ bugs/issue1327.sh view
@@ -0,0 +1,27 @@+#!/usr/bin/env bash+set -ev++# See issue1327.+# results in the error:+# patches to commute_to_end does not commutex (1) at src/Darcs/Patch/Depends.hs:452+++rm -rf temp1 temp2+mkdir temp1+cd temp1+darcs init+echo fileA version 1 > fileA+echo fileB version 1 > fileB+darcs add fileA fileB+darcs record --author foo@bar --ignore-times --all -m "Add fileA and fileB"+echo fileA version 2 > fileA+darcs record --author foo@bar --ignore-times --all -m "Modify fileA"+cd ..+darcs get temp1 temp2+cd temp2+darcs obliterate -p "Modify fileA" --all+darcs unrecord -p "Add fileA and fileB" --all+darcs record --author foo@bar --ignore-times --all fileA -m "Add just fileA"+cd ../temp1+darcs pull --all ../temp2+echo y | darcs obliterate --dont-prompt-for-dependencies -p "Add fileA and fileB"
+ bugs/issue1337_darcs_changes_false_positives.sh view
@@ -0,0 +1,37 @@+#!/usr/bin/env bash+## Test for issue1337 - darcs changes shows unrelated patches+## Asking "darcs changes" about an unrecorded file d/f will list the+## patch that creates the parent directory d/ (instead of no patches).+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib++rm -rf temp1+darcs init --repodir temp1+cd temp1+mkdir d+darcs record -lam d d+# We use --match 'touch d/f' instead of simply d/f because the latter+# prints "Changes to d/f:\n" before the count.+test 0 -eq "$(darcs changes --count --match 'touch d/f')"
+ bugs/issue1396_changepref-conflict.sh view
@@ -0,0 +1,32 @@+#!/usr/bin/env bash+set -ev++. ../tests/lib++rm -rf temp1 temp1a temp1b++mkdir temp1+cd temp1+darcs init+darcs setpref test 'echo nothing'+darcs record -am 'null pref'+cd ..++darcs get temp1 temp1a+cd temp1a+darcs setpref test 'echo a'+darcs record -am 'pref a'+cd ..++darcs get temp1 temp1b+cd temp1b+darcs setpref test 'echo b'+darcs record -am 'pref b'+cd ..++cd temp1+darcs pull -a ../temp1a --dont-allow-conflicts+not darcs pull -a ../temp1b --dont-allow-conflicts+cd ..++rm -rf temp1 temp1a temp1b
+ bugs/issue1401_bug_in_get_extra.sh view
@@ -0,0 +1,44 @@+#!/usr/bin/env bash+## Test for issue1401 - when two repos share a HUNK patch, but that+## patch's ADDFILE dependency is met by different patches in each+## repo, it becomes impossible to pull between the two repos.+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib++## This bug only affects darcs-2 repositories.+fgrep darcs-2 ~/.darcs/defaults &>/dev/null || exit 0++rm -rf d e                      # Another script may have left a mess.+darcs initialize --repodir d/+darcs initialize --repodir e/+touch d/f d/g e/f+darcs record     --repodir d/ -lam 'Add f and g'+darcs record     --repodir e/ -lam 'Add f'+echo >d/f+darcs record     --repodir d/ -am 'Change f'+darcs pull       --repodir e/ -a d/+darcs obliterate --repodir e/ -ap 'Add f and g'+darcs pull       --repodir e/ -a d/+rm -rf d/ e/                    # Clean up after ourselves.
+ bugs/issue1406.sh view
@@ -0,0 +1,19 @@+#!/bin/sh+rm -rf temp1+darcs init --repodir temp1++cd temp1++echo "test exit 1" > _darcs/prefs/prefs+echo "name" > _darcs/prefs/author+echo "a" > a+darcs record --look-for-adds --no-test --all --patch-name=p1+echo "b" >> a+echo "y" | darcs amend-record --all --patch=p1++# There should be one patch in the repo+test 1 -eq `darcs changes --count` || exit 1++# Another check: there should be nothing new after a is restored+echo "a" > a+darcs whatsnew -l && exit 1 || exit 0
+ bugs/issue1442_encoding_round-trip.sh view
@@ -0,0 +1,50 @@+#!/usr/bin/env bash+## -*- coding: utf-8 -*-+## Test for issue1442 - if we disable Darcs escaping and don't change+## our encoding, the bytes in a filename should be the same bytes that+## "darcs changes -v" prints to the right of "addfile" and "hunk".+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib++rm -rf R                        # Another script may have left a mess.++## Use the first UTF-8 locale we can find.+export LC_ALL=$(locale -a | egrep 'utf8|UTF-8' | head -1)+export DARCS_DONT_ESCAPE_ANYTHING=True++## If LC_ALL is the empty string, this system doesn't support UTF-8.+if test -z "$LC_ALL"+then exit 1+fi++darcs init      --repo R+echo '首頁 = א₀' >R/'首頁 = א₀'+darcs record    --repo R -lam '首頁 = א₀' '首頁 = א₀'+darcs changes   --repo R -v '首頁 = א₀' >R/log+#cat R/log                      # Show the humans what the output was.+grep -c '首頁 = א₀' R/log >R/count+echo 5 >R/expected-count+cmp R/count R/expected-count    # Both count files should contain "5\n".+rm -rf R                        # Clean up after ourselves.
+ bugs/issue1461_case_folding.sh view
@@ -0,0 +1,83 @@+#!/usr/bin/env bash+## Test for issue1461 - patches to files whose names only differ by+## case can be wrongly applied to the same file in the working directory.+##+## Copyright (C) 2009 Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib                  # Load some portability helpers.+rm -rf lower upper joint        # Another script may have left a mess.+mkdir lower upper++cd lower+darcs init+cat > a << EOF+1+2+3+EOF+darcs add a+darcs record -am 'lower init a'+cd ..++cd upper+darcs init+cat > A << EOF+1+2+3+EOF+darcs add A+darcs record -am 'upper init A'+cd ..++darcs get lower joint+cd joint+darcs pull -a ../upper+cd ..++cd lower+cat > a << EOF+one lower+2+3+EOF+darcs record -am 'lower modify'+cd ..++cd upper+cat > A << EOF+1+2+three upper+EOF+darcs record -am 'upper modify'+cd ..++cd joint+darcs pull ../lower -a+darcs pull ../upper -a+grep one a && not grep three a+grep three A && not grep one A+cd ..+# clean up after ourselves+rm -rf lower upper joint
+ bugs/issue1473_annotate_repodir.sh view
@@ -0,0 +1,21 @@+#!/usr/bin/env bash+set -ev++. ../tests/lib+rm -rf temp+mkdir temp+cd temp+darcs init+mkdir a b+touch a/a b/b+darcs add --rec .+darcs record -a -m ab -A test+darcs annotate a/a+# annotate --repodir=something '.' should work+cd ..+darcs annotate --repodir temp '.'+cd temp++cd ..+rm -rf temp+
bugs/issue390_whatsnew.sh view
@@ -4,6 +4,11 @@  set -ev +if ! test -x "$(which strace)"+then echo skipping test since strace was not found+     exit+fi+ rm -rf temp mkdir temp cd temp@@ -13,22 +18,16 @@ darcs add file* darcs record -am "test" -TRACE=`which strace`-if test -x $TRACE+strace darcs whatsnew file1 &> out+# we should be accessing file1+grep file1 out+# but shouldn't be accessing file2+if grep file2 out then-    strace darcs whatsnew file1 &> out-    # we should be accessing file1-    grep file1 out-    # but shouldn't be accessing file2-    if grep file2 out-    then-        echo A whatsnew for file1 should not involve a 'stat' call to file2-        exit 1-    else-        echo Yay.  We pass.-    fi+    echo A whatsnew for file1 should not involve a 'stat' call to file2+    exit 1 else-    echo skipping test since strace was not found+    echo Yay.  We pass. fi  rm -rf temp
+ bugs/record-scaling.sh view
@@ -0,0 +1,36 @@+#!/usr/bin/env bash+## Test for issueN - darcs record shouldn't access old inventories!+##+## Copyright (C) 2008  David Roundy+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib                  # Load some portability helpers.+which strace                    # This test requires strace(1).+rm -rf R                        # Another script may have left a mess.+darcs init      --repo R        # Create our test repo.+touch R/a-unique-filename+strace -eopen -oR/trace \+  darcs record  --repo R -lam 'A unique commit message.'+grep a-unique-filename R/trace+grep _darcs/hashed_inventory R/trace+not grep _darcs/inventories/ R/trace+rm -rf R                        # Clean up after ourselves.
+ contrib/_darcs.zsh view
@@ -0,0 +1,36 @@+#compdef darcs+## Darcs completion snippet for zsh.+##+## Copyright (C) 2009  Nicolas Pouillard+##+## This program is free software; you can redistribute it and/or modify+## it under the terms of the GNU General Public License as published by+## the Free Software Foundation; either version 2 of the License, or+## (at your option) any later version.+##+## This program is distributed in the hope that it will be useful,+## but WITHOUT ANY WARRANTY; without even the implied warranty of+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+## GNU General Public License for more details.++if (($CURRENT == 2)); then+  # We're completing the first word after "darcs" -- the command.+  _wanted command expl 'darcs command' \+    compadd -- $( darcs --commands )+else+  case "${words[$CURRENT]}"; in+    # If it looks like an URL...+    ht*|ft*)+        _arguments '*:URL:_urls'+        ;;+    # If it looks like an explicit path...+    /*|./*|\~*|../*)+        _arguments '*:file:_files'+        ;;+    # Otherwise, let's ask darcs for all possible options+    *)+      _wanted args expl 'arg for darcs command' \+        compadd -- $( darcs ${words[2]} --list-option )+      ;;+  esac+fi
+ contrib/cgi/README.in view
@@ -0,0 +1,42 @@+darcs.cgi is the darcs repository viewer.  It provides a web interface+for viewing darcs repositories, using XSLT to transform darcs' XML+output into XHTML. It is written in perl and is more featureful than+the older haskell cgi program darcs_cgi.lhs (seen in URLs as "darcs").++dependencies++  darcs.cgi requires with the following tools and has been tested with+  the version mentioned:++  darcs-1.0.1           http://www.darcs.net+  libxslt-1.1.6         http://xmlsoft.org/XSLT/+  perl-5.8.0            http://www.perl.com++installation++  1) copy darcs.cgi to your webserver's cgi directory, eg+     /usr/lib/cgi-bin. A symlink probably won't do. Make+     sure it's executable.+  2) copy cgi.conf to @sysconfdir@/darcs/cgi.conf and edit appropriately.+     You can overwrite the cgi.conf used by the old darcs cgi script.+     You probably don't need to change anything here.+  3) copy the xslt directory to @datadir@/darcs/xslt+  4) copy xslt/styles.css to @sysconfdir@/darcs/styles.css++  Test by browsing "http://<host>/cgi-bin/darcs.cgi/".++troubleshooting++  if the configuration is incorrect error messages will be printed to+  the webserver's error log, for example "/var/log/apache/error.log".++  you can also double check the configuration by running darcs.cgi+  from the command line and supplying a --check argument:++     $ ./darcs.cgi --check++character encodings++  if your repositories contain files with characters encoded in+  something other than ASCII or UTF-8, change the 'xml_encoding'+  setting in cgi.conf to the appropriate encoding.
+ contrib/cgi/cgi.conf.in view
@@ -0,0 +1,31 @@+# This is an example for cgi.conf++# reposdir is the directory containing the repositories++reposdir = /var/www/repos++# cachedir is a directory writable by www-data (or whatever user your cgi+# scripts run as) which is used to cache the web pages.++cachedir = /var/cache/darcs++# The following are used by darcs.cgi (not darcs_cgi)+PATH = /bin:/usr/bin:/usr/local/bin++# paths to executables, or just the executables if they are in 'PATH'+#darcs = darcs+#xsltproc = xsltproc++# Path to XSLT templates (default is /usr/local/share/darcs/xslt)+xslt_dir = @datadir@/darcs/xslt++# HTTP request path of the style sheet, the default will magically read +# @sysconfdir@/darcs/styles.css+#stylesheet = /cgi-bin/darcs.cgi/styles.css++css_styles  = @sysconfdir@/darcs/styles.css++# encoding to include in XML declaration.  Set this to the encoding used+# by the files in your repositories.++xml_encoding = UTF-8
+ contrib/cgi/darcs.cgi.in view
@@ -0,0 +1,491 @@+#!/usr/bin/perl -T+#+# darcs.cgi - the darcs repository viewer+#+# Copyright (c) 2004 Will Glozer+#+# Permission is hereby granted, free of charge, to any person obtaining+# a copy of this software and associated documentation files (the+# "Software"), to deal in the Software without restriction, including+# without limitation the rights to use, copy, modify, merge, publish,+# distribute, sublicense, and/or sell copies of the Software, and to+# permit persons to whom the Software is furnished to do so, subject to+# the following conditions+#+# The above copyright notice and this permission notice shall be+# included in all copies or substantial portions of the Software.+#+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++#+# This program calls darcs (or its own subroutines) to generate XML+# which is rendered into HTML by XSLT.  It is capable of displaying+# the files in a repository, various patch histories, annotations, etc.+#++use strict;++use CGI qw( :standard );+use CGI::Util;+use File::Basename;+use File::stat;+use IO::File;+use POSIX;++## the following variables can be customized to reflect your system+## configuration by defining them appropriately in the file+## "@sysconfdir@/darcs/cgi.conf".  The syntax accepts equals signs or simply+## blanks separating values from assignments.++$ENV{'PATH'} = read_conf('PATH', $ENV{'PATH'});++# path to executables, or just the executable if they are in $ENV{'PATH'}+my $darcs_program    = read_conf("darcs", "darcs");+my $xslt_program     = read_conf("xsltproc", "xsltproc");++# directory containing repositories+my $repository_root  = read_conf("reposdir", "/var/www");++# XSLT template locations+my $template_root = read_conf("xslt_dir", '@datadir@/darcs/xslt');++my $xslt_annotate = "$template_root/annotate.xslt";+my $xslt_browse   = "$template_root/browse.xslt";+my $xslt_patches  = "$template_root/patches.xslt";+my $xslt_repos    = "$template_root/repos.xslt";+my $xslt_rss      = "$template_root/rss.xslt";++my $xslt_errors   = "$template_root/errors.xslt";++# CSS stylesheet that XSLT templates refer to.  This is a HTTP request+# path, not a local file system path. The default will cause darcs.cgi+# to serve the stylesheet rather than the web server.+my $stylesheet = read_conf("stylesheet", "/cgi-bin/darcs.cgi/styles.css");++# location of the CSS stylesheet that darcs.cgi will serve if it+# receives a request for '/styles.css'+my $css_styles = read_conf("css_styles", '@sysconfdir@/darcs/styles.css');++# location of the favicon that darcs.cgi will serve if it+# receives a request for '/[\w\-]+/favicon.ico'+my $favicon = read_conf("favicon", "/cgi-bin/favicon.ico");++# XML source for the error pages+my $xml_errors = "$template_root/errors.xml";++# encoding to include in XML declaration+my $xml_encoding = read_conf("xml_encoding", "UTF-8");++## end customization++# ----------------------------------------------------------------------++# read a value from the cgi.conf file.+{+  my(%conf);++  sub read_conf {+    my ($flag, $val) = @_;+    $val = "" if !defined($val);+    +    if (!%conf && open(CGI_CONF, '@sysconfdir@/darcs/cgi.conf')) {+      while (<CGI_CONF>) {+        chomp;+	next if /^\s*(?:\#.*)?$/;   # Skip blank lines and comment lines+        if (/^\s*(\S+)\s*(?:\=\s*)?(\S+)\s*$/) {+           $conf{$1} = $2;+	   # print "read_conf: $1 = $2\n";+        } else {+           warn "read_conf: $_\n";+        }+      }+      close(CGI_CONF);+    }++    $val = $conf{$flag} if exists($conf{$flag});++    return $val;+  }+}++# open xsltproc to transform and output `xml' with stylesheet file `xslt'+sub transform {+    my ($xslt, $args, $content_type) = @_;++    $| = 1;+    printf "Content-type: %s\r\n\r\n", $content_type || "text/html";+    my $pipe = new IO::File "| $xslt_program $args $xslt -";+    $pipe->autoflush(0);+    return $pipe;+}++sub pristine_dir {+    my ($repo) = @_;+    my $pristine = "current";+    if (! -d "${repository_root}/${repo}/_darcs/$pristine") {+        $pristine = "pristine";+    }+    return "${repository_root}/${repo}/_darcs/$pristine";+}++# begin an XML document with a root element and the repository path+sub make_xml {+    my ($fh, $repo, $dir, $file) = @_;+    my ($full_path, $path) = '/';++    printf $fh qq(<?xml version="1.0" encoding="$xml_encoding"?>\n);++    printf $fh qq(<darcs repository="$repo" target="%s/%s%s">\n),+        $repo, ($dir ? "$dir/" : ''), ($file ? "$file" : '');++    print $fh qq(<path>\n);+    foreach $path (split('/', "$repo/$dir")) {+        $full_path .= "$path/";+        print $fh qq(<directory full-path="$full_path">$path</directory>\n);+    }+    if ($file) {+        print $fh qq(<file full-path="$full_path$file">$file</file>\n) if $file;+    }+    print $fh qq(</path>\n\n);+}++# finish XML output+sub finish_xml {+    my ($fh) = @_;+    print $fh "\n</darcs>\n";+    $fh->flush;+}++# run darcs and wrap the output in an XML document+sub darcs_xml {+    my ($fh, $repo, $cmd, $args, $dir, $file) = @_;++    make_xml($fh, $repo, $dir, $file);++    push(@$args, '--xml-output');+    darcs($fh, $repo, $cmd, $args, $dir, $file);++    finish_xml($fh);+}++# run darcs with output redirected to the specified file handle+sub darcs {+    my ($fh, $repo, $cmd, $args, $dir, $file) = @_;+    my (@darcs_argv) = ($darcs_program, $cmd, @$args);++    # push target only if there is one, otherwise darcs will get an empty param+    if ($dir || $file) {+        push(@darcs_argv, sprintf("%s%s%s", $dir, ($dir ? '/' : ''), $file));+    }++    my($pid) = fork;+    if ($pid) {+	# in the parent process+	my($status) = waitpid($pid, 0);+	die "$darcs_program exited with status $?\n" if $?;+    } elsif(defined($pid)) {+	# in the child process+	open(STDIN, '/dev/null');+	if (defined($fh)) {+	    open(STDOUT, '>&', $fh)+		|| die "can't dup to stdout: $!\n";+	}+	chdir "$repository_root/$repo"+	    || die "chdir: $repository_root/$repo: $!\n";+	exec @darcs_argv;+	die "can't exec ".$darcs_argv[0].": $!\n";+    } else {+	# fork failed+	die "can't fork: $!\n";+    }+}++# get a directory listing as XML output+sub dir_listing {+    my ($fh, $repo, $dir) = @_;+    make_xml($fh, $repo, $dir, '');++    print $fh "<files>\n";+    my $dir_ = pristine_dir ($repo) . "/$dir";+    opendir(DH, $dir_);+    while( defined (my $file_ = readdir(DH)) ) {+        next if $file_ =~ /^\.\.?$/;+        my $file = "$dir_/$file_";+        my $secs  = stat($file)->mtime;+        my $mtime = localtime($secs);+        my $ts = POSIX::strftime("%Y%m%d%H%M%S", gmtime $secs);++        my ($name, $type);++         if (-d $file) {+             ($name, $type) = (basename($file) . '/', 'directory');+         } else {+             ($name, $type) = (basename($file), 'file');+         }+         print $fh qq(  <$type name="$name" modified="$mtime" ts="$ts" />\n);+    }+    closedir(DH);+    print $fh "</files>\n";++    finish_xml($fh);+}++# get a repository listing as XML output+sub repo_listing {+    my($fh) = @_;++    make_xml($fh, "", "", "");++    print $fh "<repositories>\n";+    opendir(DH, $repository_root);+    while( defined (my $name = readdir(DH)) ) {+        next if $name =~ /^\.\.?$/;+        if (-d "$repository_root/$name/_darcs") {+            print $fh qq(  <repository name="$name" />\n);+        }+    }+    closedir(DH);+    print $fh "</repositories>\n";++    finish_xml($fh);+    return $fh;+}++# show an error page+sub show_error {+    my ($type, $code, $message) = @_;+    my $xml;++    # set the xslt processing arguments+    my $xslt_args = qq {+        --stringparam error-type '$type'+        --stringparam stylesheet '$stylesheet'+    };+    $xslt_args =~ s/\s+/ /gm;++    print "Status: $code $message\r\n\r\n";+    system("$xslt_program $xslt_args $xslt_errors $xml_errors");+}++# check if the requested resource has been modified since the client last+# saw it. If not send HTTP status code 304, otherwise set the Last-modified+# and Cache-control headers.+sub is_cached {+    my ($path) = @_;+    my ($stat) = stat($path);++    # stat may fail because the path was renamed or deleted but still referred+    # to by older darcs patches+    if ($stat) {+        my $last_modified = CGI::expires($stat->mtime);++        if (http('If-Modified-Since') eq $last_modified) {+            print("Status: 304 Not Modified\r\n\r\n");+            return 1;+        }++        print("Cache-control: max-age=0, must-revalidate\r\n");+        print("Last-modified: $last_modified\r\n");+    }+    return 0;+}++# safely extract a parameter from the http request.  This applies a regexp+# to the parameter which should group only the appropriate parameter value+sub safe_param {+    my ($param, $regex, $default) = @_;+    my $value = CGI::Util::unescape(param($param));+    return ($value =~ $regex) ? $1 : $default;+}++# common regular expressions for validating passed parameters+my $hash_regex = qr/^([\w\-.]+)$/;+my $path_regex = qr@^([^\\!\$\^&*()\[\]{}<>`|';"?\r\n]+)$@;++# respond to a CGI request+sub respond {+    # untaint the full URL to this CGI+    my $cgi_url = CGI::Util::unescape(url());+    $cgi_url =~ $path_regex or die qq(bad url "$cgi_url");+    $cgi_url = $1;++    # untaint script_name, reasonable to expect only \w, -, /, and . in the name+    my $script_name = CGI::Util::unescape(script_name());+    $script_name =~ qr~^([\w/.\-\~]+)$~ or die qq(bad script_name "$script_name");+    $script_name = $1;++    # untaint simple parameters, which can only have chars matching \w++    my $cmd  = safe_param('c', '^(\w+)$', 'browse');+    my $sort = safe_param('s', '^(\w+)$', '');++    # set the xslt processing arguments+    my $xslt_args = qq {+        --stringparam cgi-program '$script_name'+        --stringparam cgi-url '$cgi_url'+        --stringparam sort-by '$sort'+        --stringparam stylesheet '$stylesheet'+    };+    $xslt_args =~ s/\s+/ /gm;++    my ($path) = CGI::Util::unescape(path_info());+    # don't allow ./ or ../ in paths+    $path =~ s|[.]+/||g;++    # check whether we're asking for styles.css+    if ($path eq '/styles.css') {+        return if is_cached($css_styles);++        open (STYLES_CSS, $css_styles) or die qq(couldn't open "${css_styles}");+        my $size = stat($css_styles)->size;++        print "Content-length: $size\r\n";+        print "Content-type: text/css\r\n\r\n";++        while (<STYLES_CSS>) {+          print $_;+        }+        close (STYLES_CSS);+        return;+    }++    # check whether we're asking for favicon.ico+    if ($path =~ '/[\w\-]+/favicon.ico') {+        return if is_cached($favicon);++        open (FAVICON, $favicon) or die qq(couldn't open "${favicon}");+        my $size = stat($favicon)->size;++        print "Content-length: $size\r\n";+        print "Content-type: image/x-icon\r\n\r\n";++        while (<FAVICON>) {+          print $_;+        }+        close (FAVICON);+        return;+    }++    # when no repository is requested display available repositories+    if (length($path) < 2) {+        my $fh = transform($xslt_repos, $xslt_args);+        repo_listing($fh);+        return;+    }++    # don't allow any shell meta characters in paths+    $path =~ $path_regex or die qq(bad path_info "$path");+    my @path = split('/', substr($1, 1));++    # split the path into a repository, directory, and file+    my ($repo, $dir, $file, @bits) = ('', '', '');+    while (@path > 0) {+        $repo = join('/', @path);+        # check if remaining path elements refer to a repo+        if (-d "${repository_root}/${repo}/_darcs") {+            if (@bits > 1) {+                $dir  = join('/', @bits[0..$#bits - 1]);+            }+            $file = $bits[$#bits];+            # check if last element of path, stored in $file, is really a dir+            if (-d (pristine_dir ($repo) . "/${dir}/${file}")) {+                $dir = ($dir ? "$dir/$file" : $file);+                $file = '';+            }+            last;+        } else {+            $repo = '';+            unshift(@bits, pop @path);+        }+    }++    # make sure the repository exists+    unless ($repo) {+        show_error('invalid-repository', '404', 'Invalid repository');+        return;+    }++    # don't generate output unless the requested path has been+    # modified since the client last saw it.+    return if is_cached(pristine_dir ($repo) . "/$dir/$file");++    # untaint patches and tags. Tags can have arbitrary values, so+    # never pass these unquoted, on pain of pain!+    my $patch = safe_param('p', $hash_regex);+    my $tag   = safe_param('t', '^(.+)$');++    my @darcs_args;+    push(@darcs_args, '--match', "hash $patch") if $patch;+    push(@darcs_args, '-t', $tag) if $tag;++    # process the requested command+    if ($cmd eq 'browse') {+        my $fh = transform($xslt_browse, $xslt_args);+        dir_listing($fh, $repo, $dir);+    } elsif ($cmd eq 'patches') {+        # patches as an option is used to support "--patches"+        if (my $patches = safe_param('patches','^(.+)$')) {+            push @darcs_args, '--patches', $patches;+        }++        my $fh = transform($xslt_patches, $xslt_args);+        darcs_xml($fh, $repo, "changes", \@darcs_args, $dir, $file);+    } elsif ($cmd eq 'annotate') {+        push(@darcs_args, '--summary');++        my $creator_hash  = safe_param('ch', $hash_regex);+        my $original_path = safe_param('o', $path_regex);+        my $fh = transform($xslt_annotate, $xslt_args);++        # use the creator hash and original file name when available so+        # annotations can span renames+        if ($creator_hash ne '' && $original_path ne '') {+            push(@darcs_args, '--creator-hash', $creator_hash);+            darcs_xml($fh, $repo, "annotate", \@darcs_args, '', $original_path);+        } else {+            darcs_xml($fh, $repo, "annotate", \@darcs_args, $dir, $file);+        }+    } elsif ($cmd eq 'diff') {+        push(@darcs_args, '-u');+        print "Content-type: text/plain\r\n\r\n";+        darcs(undef, $repo, "diff", \@darcs_args, $dir, $file);+    } elsif ($cmd eq 'rss') {+        push(@darcs_args, '--last', '25');++        my $fh = transform($xslt_rss, $xslt_args, "application/rss+xml");+        darcs_xml($fh, $repo, "changes", \@darcs_args, $dir, $file);+    } else {+        show_error('invalid-command', '400', 'Invalid command');+    }+}++# run a self-test when the --check argument is supplied+if ($ARGV[0] eq '--check') {+    (read_conf("css_styles", "abc") ne "abc") ||+        die "cannot read config file: $!\n";++    (`$darcs_program`) ||+        die "cannot execute darcs as '$darcs_program': $!\n";+    (`$xslt_program`) ||+        die "cannot execute xstlproc as '$xslt_program': $!\n";++    (-d $repository_root && -r $repository_root) ||+        die "cannot read repository root directory '$repository_root': $!\n";+    (-d $template_root && -r $template_root) ||+        die "cannot read template root directory '$template_root': $!\n";+    (-f $css_styles) ||+        die "cannot read css stylesheet '$css_styles': $!\n";+    (-f $xml_errors) ||+        die "cannot read error messages '$xml_errors': $!\n";++    exit 0;+}++# handle the CGI request+respond();+
+ contrib/cgi/xslt/annotate.xslt view
@@ -0,0 +1,390 @@+<?xml version="1.0" encoding="utf-8"?>++<!--+ template for converting darcs' `annotate` output from XML to XHTML.  This+ template expects the following external variables:++   cgi-program    - path to the CGI executable, to place in links+   sort-by        - field to sort by+   stylesheet     - path to the CSS stylesheet++-->+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">+  <xsl:strip-space elements="*"/>++  <xsl:include href="common.xslt"/>++  <xsl:template match="path">+    <h1 class="target">+        annotations for <span class="path"><a href="{$cgi-program}">projects</a></span> / <span class="path"><xsl:apply-templates/></span>+    </h1>+  </xsl:template>++  <!-- patch annotate tags -->+  <xsl:template match="/darcs/patch">+    <xsl:call-template name="show-patch-info">+      <xsl:with-param name="patch" select="."/>+      <xsl:with-param name="show-comment" select="true()"/>+      <xsl:with-param name="show-author" select="true()"/>+      <xsl:with-param name="show-date" select="true()"/>+    </xsl:call-template>+  </xsl:template>+  +  <xsl:template match="summary">+    <xsl:variable name="hash" select="../patch/@hash"/>+      +    <table>+      <tr class="annotate">+        <th>file</th>+        <th>change</th>+        <th></th>+        <th></th>+      </tr>++      <xsl:apply-templates/>+    </table>++    <form action="{$command}" method="get">+      <p>+        <input type="submit" name="c" value="diff"/>+        <input type="hidden" name="p" value="{$hash}"/>+      </p>+    </form>+  </xsl:template>+  +  <xsl:template match="modify_file">+    <xsl:variable name="file" select="text()"/>+    <xsl:variable name="hash" select="/darcs/patch/@hash" />+      +    <tr class="modified-file">+      <td><xsl:value-of select="$file"/></td>++      <td class="line-count">+        <xsl:for-each select="added_lines">+          +<xsl:value-of select="@num"/>/+        </xsl:for-each>+        <xsl:for-each select="removed_lines">-<xsl:value-of select="@num"/>+        </xsl:for-each>+        lines+      </td>++      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$file}?c=patches">patches</a></td>+    </tr>+  </xsl:template>++  <xsl:template match="add_file">+    <xsl:variable name="file" select="text()"/>+    <xsl:variable name="hash" select="/darcs/patch/@hash" />+    +    <tr class="add-remove-file">+      <td><xsl:value-of select="$file"/></td>+      <td>added file</td>+      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$file}?c=patches">patches</a></td>+    </tr>+  </xsl:template>++  <xsl:template match="move">+    <xsl:variable name="file" select="@to"/>+    <xsl:variable name="old-file" select="@from"/>    +    <xsl:variable name="hash" select="/darcs/patch/@hash" />+    +    <tr class="add-remove-file">+      <td><xsl:value-of select="$file"/></td>+      <td>moved from <xsl:value-of select="$old-file"/></td>+      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$file}?c=patches">patches</a></td>+    </tr>+  </xsl:template>++  <xsl:template match="remove_file">+    <xsl:variable name="file" select="text()"/>+    <xsl:variable name="hash" select="/darcs/patch/@hash" />+    +    <tr class="add-remove-file">+      <td><xsl:value-of select="$file"/></td>+      <td>removed file</td>+      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$file}?c=patches">patches</a></td>+    </tr>+  </xsl:template>++  <xsl:template match="add_directory">+    <xsl:variable name="dir" select="text()"/>+    <xsl:variable name="hash" select="/darcs/patch/@hash" />+    +    <tr class="add-remove-file">+      <td><xsl:value-of select="$dir"/></td>+      <td>added directory</td>+      <td><a href="{$command}{$dir}/?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$dir}/?c=patches">patches</a></td>+    </tr>+  </xsl:template>++  <xsl:template match="remove_directory">+    <xsl:variable name="dir" select="text()"/>+    <xsl:variable name="hash" select="/darcs/patch/@hash" />+    +    <tr class="add-remove-file">+      <td><xsl:value-of select="$dir"/></td>+      <td>removed directory</td>+      <td><a href="{$command}{$dir}/?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$dir}/?c=patches">patches</a></td>+    </tr>+  </xsl:template>+  +  <!-- directory annotate templates -->+  <xsl:template match="/darcs/directory">+    <xsl:call-template name="show-patch-info">+      <xsl:with-param name="patch" select="modified/patch"/>+    </xsl:call-template>++    <table>+      <tr class="annotate">+        <th>file</th>+        <th>change</th>+        <th></th>+        <th></th>+      </tr>++      <xsl:apply-templates/>+    </table>+  </xsl:template>+  +  <xsl:template match="directory/modified/modified_how">+    <xsl:variable name="hash" select="../patch/@hash" />+    <xsl:variable name="how" select="substring(text(), 0, 10)"/>+    <xsl:variable name="target" select="/darcs/@target"/>++    <!--+      annotating a directory outputs the directory itself as well as+      any contents.  this ugly code checks if the matching element is+      the original directory so that the 'annotate' and 'patch' links+      don't append the directory twice.+    -->+    <xsl:variable name="last" select="//darcs/path/directory[last()]"/>+    <xsl:variable name="name" select="../../@name"/>+    <xsl:variable name="dir">+      <xsl:choose>+        <xsl:when test="$last = $name"></xsl:when>+        <xsl:otherwise><xsl:value-of select="$name"/>/</xsl:otherwise>+      </xsl:choose>+    </xsl:variable>++    <tr class="add-remove-file">+      <td><xsl:value-of select="$name"/></td>+      <td>+        <xsl:choose>+          <xsl:when test="$how = 'Dir added'">added directory</xsl:when>+          <xsl:when test="$how = 'Dir moved'">moved directory</xsl:when>+          <xsl:when test="$how = 'Dir remov'">removed directory</xsl:when>+        </xsl:choose>+      </td>+      <td>+        <a href="{$command}{$dir}?c=annotate&amp;p={$hash}">annotate</a>+      </td>+      <td><a href="{$command}{$dir}?c=patches">patches</a></td>+    </tr>+  </xsl:template>++  <xsl:template match="directory/file/modified/modified_how">+    <xsl:variable name="file" select="../../@name"/>+    <xsl:variable name="hash" select="../patch/@hash" />+    <xsl:variable name="how" select="substring(text(), 0, 11)"/>+    +    <tr class="add-remove-file">+      <td><xsl:value-of select="$file"/></td>+      <td>+        <xsl:choose>+          <xsl:when test="$how = 'File added'">added file</xsl:when>+          <xsl:when test="$how = 'File moved'">moved file</xsl:when>+          <xsl:when test="$how = 'File remov'">removed file</xsl:when>+        </xsl:choose>+      </td>+      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>+      <td><a href="{$command}{$file}?c=patches">patches</a></td>+    </tr>+  </xsl:template>+   +  <!-- file annotate templates -->+  <xsl:template match="/darcs/file">+    <xsl:variable name="modified_how" select="modified/modified_how/text()"/>+    +    <xsl:call-template name="show-patch-info">+      <xsl:with-param name="patch" select="modified/patch"/>+    </xsl:call-template>++    <!-- don't display table of changes when file's contents are modified -->+    <xsl:if test="$modified_how != 'File modified'">+      <xsl:variable name="file" select="@name"/>+      <xsl:variable name="how" select="substring($modified_how, 0, 11)"/>++      <xsl:variable name="annotate-href">+        <xsl:call-template name="make-annotate-href">+          <xsl:with-param name="hash" select="modified/patch/@hash"/>+        </xsl:call-template>+      </xsl:variable>+      +      <table>+        <tr class="annotate">+          <th>file</th>+          <th>change</th>+          <th></th>+          <th></th>+        </tr>++        <tr class="add-remove-file">+          <td><xsl:value-of select="$file"/></td>+          <td>+            <xsl:choose>+              <xsl:when test="$how = 'File added'">added file</xsl:when>+              <xsl:when test="$how = 'File moved'">moved file</xsl:when>+              <xsl:when test="$how = 'File remov'">removed file</xsl:when>+            </xsl:choose>+          </td>+          <td><a href="{$annotate-href}">annotate</a></td>+          <td><a href="{$command}?c=patches">patches</a></td>+        </tr>+      </table>+    </xsl:if>++    <!-- the empty <p/> element is a Konqueror bug workaround -->+    <pre xml:space="preserve"><p/>+      <xsl:apply-templates/>+    </pre>+  </xsl:template>+  +  <xsl:template match="added_line">+    <xsl:variable name="annotate-href">+      <xsl:call-template name="make-annotate-href">+        <xsl:with-param name="hash" select="preceding::modified/patch/@hash"/>+      </xsl:call-template>+    </xsl:variable>++    <xsl:variable name="annotate-name" select="preceding::modified/patch/name"/>+    <xsl:variable name="author" select="preceding::modified/patch/@author"/>+    +    <a class="added-line" href="{$annotate-href}" title="added with '{$annotate-name}' by '{$author}'">+      <pre><xsl:value-of select="text()"/></pre>+    </a>+    <xsl:call-template name="check-removed-by"/>+  </xsl:template>++  <xsl:template match="normal_line">+    <xsl:variable name="annotate-href">+      <xsl:call-template name="make-annotate-href">+        <xsl:with-param name="hash" select="*/patch/@hash"/>+      </xsl:call-template>+    </xsl:variable>++    <xsl:variable name="annotate-name" select="*/patch/name"/>+    <xsl:variable name="author" select="*/patch/@author"/>++    <a class="normal-line" href="{$annotate-href}" title="last changed with '{$annotate-name}' by '{$author}'">+      <pre><xsl:value-of select="text()"/></pre>+    </a>+    <xsl:call-template name="check-removed-by"/>+  </xsl:template>++  <xsl:template match="removed_line">+    <xsl:variable name="annotate-href">+      <xsl:call-template name="make-annotate-href">+        <xsl:with-param name="hash" select="*/patch/@hash"/>+      </xsl:call-template>+    </xsl:variable>++    <xsl:variable name="annotate-name" select="*/patch/name"/>+    <xsl:variable name="author" select="*/patch/@author"/>+    +    <!-- don't display removed lines when a file is removed -->+    <xsl:if test="../modified/modified_how/text() != 'File removed'">+      +        <a class="removed-line" href="{$annotate-href}" title="removed with '{$annotate-name}' by '{$author}'">+        <pre><xsl:value-of select="text()"/></pre>+      </a>+      <xsl:call-template name="check-removed-by"/>+    </xsl:if>+  </xsl:template>++  <xsl:template name="check-removed-by">+    <xsl:variable name="hash" select="removed_by/patch/@hash"/>+    +    <xsl:variable name="annotate-href">+      <xsl:call-template name="make-annotate-href">+        <xsl:with-param name="hash" select="$hash"/>+      </xsl:call-template>+    </xsl:variable>+    +    <xsl:choose>+      <xsl:when test="$hash != ''">+        <a class="removed-by" href="{$annotate-href}">-</a>+      </xsl:when>+    </xsl:choose>++    <!-- put a newline after the hyperlink -->      +    <xsl:text xml:space="preserve">+    </xsl:text>+  </xsl:template>++  <xsl:template name="show-patch-info">+    <xsl:param name="patch"/>+    <xsl:param name="show-comment"/>+    <xsl:param name="show-author"/>+    <xsl:param name="show-date"/>+    +    <xsl:variable name="hash" select="$patch/@hash"/>+    <xsl:variable name="name" select="$patch/name"/>+    <xsl:variable name="author" select="$patch/@author"/>+    <xsl:variable name="local_date" select="$patch/@local_date"/>+    +    <h2 class="patch">+      patch "<span class="path">+      <a href="{$cgi-program}/{$repo}/?c=annotate&amp;p={$hash}">+        <xsl:value-of select="$name"/>+      </a>+      </span>"+    </h2>++    <xsl:if test="$show-comment">+        <xsl:if test="$patch/comment">+          <h2 class="patch">+            comment "<span class="comment">+            <xsl:value-of select="$patch/comment"/>+            </span>"+            </h2>+        </xsl:if>+        </xsl:if>++      <xsl:if test="$show-author"> +          <h2 class="author">+        by <span class="author">+        <xsl:value-of select="$patch/@author"/>+        </span>++      <xsl:if test="$show-date"> +        on <span class="local_date">+        <xsl:value-of select="$patch/@local_date"/>+        </span>+    </xsl:if>+    </h2>+    </xsl:if>++  </xsl:template>++  <xsl:template name="make-annotate-href" xml:space="default">+    <xsl:param name="hash"/>++    <xsl:variable name="created-as" select="/darcs/*/created_as"/>+    <xsl:variable name="creator-hash" select="$created-as/patch/@hash"/>+    <xsl:variable name="original-name" select="$created-as/@original_name"/>+    +    <xsl:value-of select="$command"/>?c=annotate&amp;p=<xsl:value-of select="$hash"/>&amp;ch=<xsl:value-of select="$creator-hash"/>&amp;o=<xsl:value-of select="$original-name"/>+  </xsl:template>++  <!-- ignore <name>, <comment> and <modified_how> children -->+  <xsl:template match="name"/>+  <xsl:template match="comment"/>+  <xsl:template match="author"/>+  <xsl:template match="modified_how"/>+</xsl:stylesheet>
+ contrib/cgi/xslt/browse.xslt view
@@ -0,0 +1,110 @@+<?xml version="1.0" encoding="utf-8"?>++<!--+ template for converting a darcs current/ directory listing from XML to+ XHTML.  This template expects the following external variables:++   cgi-program    - path to the CGI executable, to place in links+   sort-by        - field to sort by+   stylesheet     - path to the CSS stylesheet++ the input XML must have the following structure, aside from what common.xslt+ expects:++ <files>+   <directory name="" modified=""/>+   <file name="" modified=""/>+ </files>+-->+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">+  <xsl:include href="common.xslt"/>++  <xsl:template match="path">+    <h1 class="target">+      files in <span class="path"><a href="{$cgi-program}">projects</a></span> / <span class="path"><xsl:apply-templates/></span>+    </h1>+  </xsl:template>+  +  <xsl:template match="files">+    <table>+      <tr class="browse">+        <th>+          <a class="sort" href="{$command}?c=browse&amp;s=name">name</a>+          <a class="revsort" href="{$command}?c=browse&amp;s=revname"> (rev)</a>+        </th>+        <th>+          <a class="sort" href="{$command}?c=browse&amp;s=ts">modified</a>+          <a class="revsort" href="{$command}?c=browse&amp;s=revts"> (rev)</a>+        </th>+        <th></th>+        <th></th>+      </tr>+      +      <xsl:choose>+        <xsl:when test="$sort-by = 'ts'">+          <xsl:apply-templates>+            <xsl:sort select="name(self::node())"/>+            <xsl:sort select="@ts"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'revts'">+          <xsl:apply-templates>+            <xsl:sort select="name(self::node())"/>+            <xsl:sort select="@ts" order="descending"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'name'">+          <xsl:apply-templates>+            <xsl:sort select="name(self::node())"/>+            <xsl:sort select="@name"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'revname'">+          <xsl:apply-templates>+            <xsl:sort select="name(self::node())"/>+            <xsl:sort select="@name" order="descending"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:otherwise>+          <xsl:apply-templates>+            <xsl:sort select="name(self::node())"/>+            <xsl:sort select="@name"/>+          </xsl:apply-templates>+        </xsl:otherwise>+      </xsl:choose>+    </table>+  </xsl:template>+  +  <xsl:template match="directory">+    <xsl:variable name="name" select="@name"/>+    <xsl:variable name="type" select="@type"/>+    +    <tr class="directory">+      <td>+        <a href="{$command}{$name}?c=browse"><xsl:value-of select="@name"/></a>+      </td>+      <td><xsl:value-of select="@modified"/></td>+      <td>+        <a href="{$command}{$name}?c=annotate">annotate</a>+      </td>+      <td>+        <a href="{$command}{$name}?c=patches">patches</a>+      </td>+    </tr>++    <xsl:apply-templates/>+  </xsl:template>++  <xsl:template match="file">+    <xsl:variable name="name" select="@name"/>+    +    <tr class="file">+      <td><xsl:value-of select="@name"/></td>+      <td><xsl:value-of select="@modified"/></td>+      <td><a href="{$command}{$name}?c=annotate">annotate</a></td>+      <td><a href="{$command}{$name}?c=patches">patches</a></td>+    </tr>++    <xsl:apply-templates/>+  </xsl:template>+</xsl:stylesheet>
+ contrib/cgi/xslt/common.xslt view
@@ -0,0 +1,66 @@+<!--+ templates fragments shared by all templates.  This template expects+ the following external variables:++   cgi-program    - path to the CGI executable, to place in links+   stylesheet     - path to the CSS stylesheet++ the input XML must have the following structure, plus any elements+ that are not common to all templates:++ <darcs repository="">+   <path>+     <element full-path=""></element>+   </path>++   ...+ + </darcs>+-->+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">+  <xsl:variable name="command">+    <xsl:value-of select="$cgi-program"/>/<xsl:value-of select="/darcs/@target"/>+  </xsl:variable>++  <xsl:variable name="repo" select="/darcs/@repository"/>+  +  <xsl:template match="/darcs">+    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">+      <head>+        <title>darcs repository</title>+        <link rel="stylesheet" href="{$stylesheet}"/>+        <link rel="alternate" type="application/rss+xml" title="RSS 2.0" href="{$command}?c=rss" />+      </head>++      <body>+        <xsl:apply-templates/>++        <form action="{$command}" method="get">+          <p>+            <input class="patches" type="submit" name="c" value="patches"/>+            +            <a href="{$command}?c=rss">rss</a>+            +            <span class="version">+              <a class="home" href="http://darcs.net/">darcs.cgi</a>+              v1.0+            </span>+          </p>+        </form>+      </body>+    </html>+  </xsl:template>++  <xsl:template match="path/directory">+    <xsl:variable name="full-path"  select="@full-path"/>+    +    <a href="{$cgi-program}{$full-path}?c=browse">+      <xsl:apply-templates/>+    </a> /+  </xsl:template>++  <xsl:template match="path/file">+    <xsl:apply-templates/>+  </xsl:template>+  +</xsl:stylesheet>
+ contrib/cgi/xslt/errors.xml view
@@ -0,0 +1,22 @@+<!--+  HTML templates for all potential error pages.  Each <error> element+  should contain all of the HTML <body> content to be output if that+  error occurs+-->+<errors>+  <error type="invalid-command" title="Invalid command">+    <h1>Invalid command</h1>++    <p>+      The requested command is invalid.+    </p>+  </error>++  <error type="invalid-repository" title="Invalid repository">+    <h1>Invalid repository</h1>++    <p>+      The requested repository does not exist on this server.+    </p>+  </error>+</errors>
+ contrib/cgi/xslt/errors.xslt view
@@ -0,0 +1,36 @@+<?xml version="1.0" encoding="utf-8"?>++<!--+ template for converting selected content of errors.xml XML to XHTML. This+ template expects the following external variables:++   error-type     - the type of error+   stylesheet     - path to the CSS stylesheet++ the input XML must have the following structure++ <errors>+   <error type="" title="">+     ...+   </error>+ </errors>+-->+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">+  <xsl:template match="error[@type = $error-type]">+    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">+      <head>+        <title>+          <xsl:value-of select="@title"/>+        </title>+        <link rel="stylesheet" href="{$stylesheet}"/>+      </head>++      <body>+        <xsl:copy-of select="*"/>+      </body>+    </html>+  </xsl:template>++  <!-- ignore errors that don't match -->+  <xsl:template match="error"/>+</xsl:stylesheet>
+ contrib/cgi/xslt/patches.xslt view
@@ -0,0 +1,125 @@+<?xml version="1.0" encoding="utf-8"?>++<!--+ template for converting darcs' `changes` output from XML to XHTML.  This+ template expects the following external variables:++   cgi-program    - path to the CGI executable, to place in links+   sort-by        - field to sort by+   stylesheet     - path to the CSS stylesheet++ the input XML must have the following structure, aside from what common.xslt+ expects:++ <changelog>+   <patch author="" date="" localdate="" inverted="" hash="">+     <name></name>+   </patch>+ </changelog>+-->+<xsl:stylesheet version="1.0"+                xmlns:xsl="http://www.w3.org/1999/XSL/Transform"+                xmlns:str="http://exslt.org/strings">+  +  <xsl:include href="common.xslt"/>++  <xsl:template match="path">+    <h1 class="target">+      patches applied to <span class="path"><a href="{$cgi-program}">projects</a></span> / <span class="path"><xsl:apply-templates/></span>+    </h1>+  </xsl:template>+  +  +  <xsl:template match="changelog">+    <table>+      <tr class="patches">+        <th>+          <a class="sort" href="{$command}?c=patches&amp;s=name">name</a>+          <a class="revsort" href="{$command}?c=patches&amp;s=revname"> (rev)</a>+        </th>+        <th>+          <a class="sort" href="{$command}?c=patches&amp;s=date">date</a>+          <a class="revsort" href="{$command}?c=patches&amp;s=revdate"> (rev)</a>+        </th>+        <th>+          <a class="sort" href="{$command}?c=patches&amp;s=author">author</a>+          <a class="revsort" href="{$command}?c=patches&amp;s=revauthor"> (rev)</a>+        </th>+        <th>+        </th>+      </tr>++      <xsl:choose>+        <xsl:when test="$sort-by = 'name'">+          <xsl:apply-templates>+            <xsl:sort select="name"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'revname'">+          <xsl:apply-templates>+            <xsl:sort select="name" order="descending"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'date'">+          <xsl:apply-templates>+            <xsl:sort select="@date"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'revdate'">+          <xsl:apply-templates>+            <xsl:sort select="@date" order="descending"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'author'">+          <xsl:apply-templates>+            <xsl:sort select="@author"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:when test="$sort-by = 'revauthor'">+          <xsl:apply-templates>+            <xsl:sort select="@author" order="descending"/>+          </xsl:apply-templates>+        </xsl:when>+        <xsl:otherwise>+          <!-- use the repository's natural order -->+          <xsl:apply-templates/>+        </xsl:otherwise>+      </xsl:choose>+    </table>+  </xsl:template>++  <xsl:template match="patch">+    <xsl:variable name="author" select="@author"/>+    <xsl:variable name="hash"   select="@hash"/>+    <xsl:variable name="name"   select="name"/>+    <xsl:variable name="repo"   select="/darcs/@repository"/>++    <xsl:variable name="created-as" select="/darcs/changelog/created_as"/>+    <xsl:variable name="creator-hash" select="$created-as/patch/@hash"/>+    <xsl:variable name="original-name" select="$created-as/@original_name"/>++    <xsl:variable name="annotate-href">+      <xsl:value-of select="$command"/>?c=annotate&amp;p=<xsl:value-of select="$hash"/>++      <xsl:if test="$creator-hash">&amp;ch=<xsl:value-of select="$creator-hash"/></xsl:if>+      <xsl:if test="$original-name">&amp;o=<xsl:value-of select="$original-name"/></xsl:if>+    </xsl:variable>+    +    <tr class="patch">+      <td><a href="{$annotate-href}"><xsl:value-of select="name"/></a></td>+      <td><xsl:value-of select="@local_date"/></td>+      <td>+        <a href="mailto:{$author}"><xsl:value-of select="$author"/></a>+      </td>+      <td>+        <a href="{$cgi-program}/{$repo}/?c=annotate&amp;p={$hash}">detail</a>+      </td>+    </tr>+    <xsl:apply-templates/>+  </xsl:template>++  <!-- ignore <created_as>, <name> and <comment> children of <patch> -->+  <xsl:template match="created_as"/>+  <xsl:template match="name"/>+  <xsl:template match="comment"/>+</xsl:stylesheet>
+ contrib/cgi/xslt/repos.xslt view
@@ -0,0 +1,59 @@+<?xml version="1.0" encoding="utf-8"?>++<!--+ template for displaying a list of available repositories, used when a+ CGI request has no repository path information.  This template expects+ the following external variables:++   cgi-program    - path to the CGI executable, to place in links+   stylesheet     - path to the CSS stylesheet++ the input XML must have the following structure:++ <darcs repository="">+   <repositories>+     <repository name=""/>+   </repositories>+ </darcs>+-->+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">+  <xsl:variable name="command">+    <xsl:value-of select="$cgi-program"/>/<xsl:value-of select="/darcs/@target"/>+  </xsl:variable>+  +  <xsl:template match="/darcs">+    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">+      <head>+        <title>darcs repository viewer</title>+        <link rel="stylesheet" href="{$stylesheet}"/>+      </head>++      <body>+        <h1 class="target">Available Repositories</h1>++        <table>+          <xsl:apply-templates/>+        </table>+      </body>+    </html>+  </xsl:template>++  <xsl:template match="repositories">+    <xsl:apply-templates>+      <xsl:sort select="name(self::node())"/>+      <xsl:sort select="@name"/>+    </xsl:apply-templates>+  </xsl:template>++  <xsl:template match="repositories/repository">+    <xsl:variable name="repository"  select="@name"/>++    <tr>+      <td>+        <a href="{$cgi-program}/{$repository}/?c=browse">+          <xsl:value-of select="$repository"/>+        </a>+      </td>+    </tr>+  </xsl:template>+</xsl:stylesheet>
+ contrib/cgi/xslt/rss.xslt view
@@ -0,0 +1,92 @@+<?xml version="1.0" encoding="utf-8"?>++<!--+ template for converting darcs' `changes` output from XML to RSS.  This+ template expects the following external variables:++   cgi-url    - full URL to the CGI executable, to place in links++ the input XML must have the following structure:++ <darcs repository="">+   <changelog>+     <patch author="" date="" localdate="" inverted="" hash="">+       <name></name>+       <comment></comment>+     </patch>+   </changelog>+ </darcs>+-->+<xsl:stylesheet version="1.0"+                exclude-result-prefixes="str"+                xmlns:xsl="http://www.w3.org/1999/XSL/Transform"+                xmlns:str="http://exslt.org/strings">++  <xsl:variable name="repo" select="/darcs/@repository"/>++  <xsl:variable name="command">+    <xsl:value-of select="$cgi-url"/>/<xsl:value-of select="/darcs/@target"/>+  </xsl:variable>++  <xsl:template match="changelog">+    <rss version="2.0">+      <channel>+        <title>changes to <xsl:value-of select="$repo"/></title>+        <link><xsl:value-of select="$command"/></link>+        <description>+          Recent patches applied to the darcs repository named+          "<xsl:value-of select='$repo'/>".+        </description>++        <xsl:apply-templates>+          <xsl:sort select="@date"/>+        </xsl:apply-templates>+      </channel>+    </rss>+  </xsl:template>++  <xsl:template match="patch">+    <xsl:variable name="hash"       select="@hash"/>++    <xsl:variable name="created-as" select="/darcs/changelog/created_as"/>+    <xsl:variable name="creator-hash" select="$created-as/patch/@hash"/>+    <xsl:variable name="original-name" select="$created-as/@original_name"/>++    <xsl:variable name="annotate-href">+      <xsl:value-of select="$command"/>?c=annotate&amp;p=<xsl:value-of select="$hash"/>++      <xsl:if test="$creator-hash">&amp;ch=<xsl:value-of select="$creator-hash"/></xsl:if>+      <xsl:if test="$original-name">&amp;o=<xsl:value-of select="$original-name"/></xsl:if>+    </xsl:variable>++    <xsl:variable name="date-nodes" select="str:tokenize(@local_date, ' ')"/>+    <xsl:variable name="rfc-date">+      <xsl:value-of select="$date-nodes[1]"/>+      <xsl:value-of select="', '"/>+      <xsl:if test="$date-nodes[3] &lt; 10">0</xsl:if>+      <xsl:value-of select="$date-nodes[3]"/>+      <xsl:value-of select="' '"/>+      <xsl:value-of select="$date-nodes[2]"/>+      <xsl:value-of select="' '"/>+      <xsl:value-of select="$date-nodes[6]"/>+      <xsl:value-of select="' '"/>+      <xsl:value-of select="$date-nodes[4]"/>+      <xsl:value-of select="' '"/>+      <xsl:value-of select="$date-nodes[5]"/>+    </xsl:variable>++    <item>+      <title><xsl:value-of select="name"/></title>+      <link><xsl:value-of select="$annotate-href"/></link>+      <author><xsl:value-of select="@author"/></author>+      <description><xsl:value-of select="comment"/></description>+      <pubDate><xsl:value-of select="$rfc-date"/></pubDate>+    </item>+  </xsl:template>++  <!-- ignore <path> <created_as>, <name> and <comment> children of <patch> -->+  <xsl:template match="path"/>+  <xsl:template match="created_as"/>+  <xsl:template match="name"/>+  <xsl:template match="comment"/>+</xsl:stylesheet>
+ contrib/cgi/xslt/styles.css view
@@ -0,0 +1,91 @@+/**+ stylesheet for darcs repository browser+**/++a:link, a:visited {+  color: blue;+  text-decoration: none;+}++a:hover { text-decoration: underline; }+a.sort  { color: black; }+a.revsort  { +  color: black;+  font-size: 75%;+}+a.home  { color: #9292C9; }++body { margin: 10px 10px 10px 10px; }++h1.target {+  font-size: 150%;+  font-weight: bold;+}++h2.patch {+  font-size: 125%;+  font-weight: bold;+  margin-top: -10px;+  padding-left: 10px;+}++h2.author {+  font-size: smaller;+  margin-top: -10px;+  font-weight: bold;+  padding-left: 30px;+}++input.patches {  margin-right: 20px; }+label.tag     {  margin-right: 5px; }++span.path, span.path > a { color: #2A2A6B; }++span.version {+  color: #9292C9;  +  margin-left: 75px;+}++span.comment {+  color: #2A2A6B;+  white-space: pre;+}++th,td {+  text-align: left;+  padding: 5px 10px 5px 10px;  +}++tr.annotate { background-color: #FFAAAA; }+tr.browse { background-color: #FFFF99; }+tr.patches { background-color: #AAFFAA; }+tr.directory { background-color: #CFCFCF; }+tr.file, tr.patch, tr.modified-file { background-color: #DCDCDA; }+tr.modified-file, tr.add-remove-file { background-color: #DCDCDA; }++pre {+    margin: 0 0 0 0;+}++a.added-line {+    color: #00AA00;+    float: left;+}++a.normal-line {+    color: #000000;+    float: left;+}++a.removed-line {+    color: #CC0000;+    float: left;+    text-decoration: line-through;+}++a.removed-by {+    clear: right;+    color: #CC0000;+    float: right;+    font-size: 125%;+}
+ contrib/cygwin-wrapper.bash view
@@ -0,0 +1,263 @@+#! /bin/bash++DIRNAME=`dirname "${0}"`+if [ "${DIRNAME:0:1}" = "/" ] ; then+ DARCSPACKAGEDIR="${DIRNAME}"+else+ DARCSPACKAGEDIR="${PWD}/${DIRNAME}"+fi++# If the DARCSPACKAGEDIR assignment above doesn't work for some funny reason, +# you could set these variables by hand.  Or fix the script to work +# automatically and submit a patch.++# Should be set to the full Cygwin path to the directory containing the +# putty executables.+putty_binary_dir="${DARCSPACKAGEDIR}"+# Should be set to the full Cygwin path to the directory containing the +# Windows binary "darcs.exe".+darcs_binary_dir="$putty_binary_dir"+# Should be set to the full Cygwin path to the Windows binary+# "darcs.exe".+darcs_binary="${darcs_binary_dir}/realdarcs.exe"++#---------------------------------------------------------------------+# Darcs Wrapper for Cygwin+#+# A Bash script that allows Cywin paths on the command line when using+# a version of Darcs compiled for Windows.  Darcs will still use still+# Windows paths internally.+#+#---------------------------------------------------------------------+# Usage+# +# Edit this file and set the variables above.  Then, rename this +# script to "darcs" and put it in your PATH somewhere before the +# original binary.+#+# Darcs needs to launch itself for some operations and so the original+# binary needs to be in your Windows PATH.  Do not rename it.+#+#---------------------------------------------------------------------+# Known Issues+#+# This script is just a stopgap measure.  Things don't work perfectly.+# We really need a Cygwin build of Darcs.+#+# No path conversion is performed on:+#    - Any preferences set with "setpref"+#    - The "COMMAND" argument to "darcs trackdown"+#+# When Darcs launches external programs, it uses a Windows system call+# to do so.  This means you may not be able to run "hash bang" scripts+# directly.  For example, to run the Bash script "myscript", you'll+# have to tell Darcs to run "bash myscript".+#+# --------------------------------------------------------------------+++PATH="$putty_binary_dir:$darcs_binary_dir:${PATH}"++debug=false++cmd="$1"++# Print each argument to stderr on a separate line.  Then exit.+function die() {+   local line+   for line in "$@"; do+      echo "$line" > /dev/stderr+   done+   exit 2+}++# Make sure 'darcs_binary_dir' is set.+if [ ! -d "$darcs_binary_dir" ]; then+   die "Please edit this script and set the 'darcs_binary_dir' variable" \+       "to refer to a valid directory." \+       "      script path = '$0'"  \+       "     darcs_binary_dir = '$darcs_binary_dir'"+fi++# Special case for when the first argument is an option.+if expr match "$cmd" '-' > /dev/null; then+   if $debug; then+      # echo "SIMPLE CASE:"+      for arg in "$@"; do+         echo "  arg = '$arg'"+      done+   else+      # echo about to exec -a darcs "$darcs_binary" "$@"+      exec -a darcs "$darcs_binary" "$@"+   fi+fi++# Shift off the darcs command name+shift++function is_opaque_opt() {+   local opt+   for opt in "${opaque_binary_opts[@]}"; do+      if [ "$opt" == "$1" ]; then+         return 0+      fi+   done+   return 1+}++function is_file_opt() {+   local opt+   for opt in "${file_binary_opts[@]}"; do+      if [ "$opt" == "$1" ]; then+         return 0+      fi+   done+   return 1+}++# Options are not dealt with in a command-specific way.  AFAIK, Darcs+# doesn't use the same option in two different ways, so we should be+# fine.++# List of "opaque" binary options.  These are options where we don't+# treat the option argument like a file.+declare -a opaque_binary_opts=( \+   '--repo-name' \+   '--to-match' '--to-patch' '--to-tag' \+   '--from-match' '--from-patch' '--from-tag' \+   '-t' '--tag' '--tags' '--tag-name' \+   '-p' '--patch' '--patches' \+   '-m' '--patch-name' \+   '--matches' '--match' \+   '--token-chars' \+   '-A' '--author' '--from' '--to' '--cc' \+   '--sign-as' '--creator-hash' \+   '--last' '--diff-opts' \+   '-d' '--dist-name' \+   '--log-file' \+   '--apply-as' \+   )++# List of binary options that take file arguments that need to be converted.+declare -a file_binary_opts=( \+   '--repodir' '--repo' '--sibling' \+   '--context' \+   '--logfile' '-o' '--output' \+   '--external-merge' \+   '--sign-ssl' '--verify' '--verify-ssl' \+   )++# --------------------------------------------------------------------+# The three command categories.  We only use the first one, but the+# others are listed to make sure we've covered everything.  Luckily,+# there aren't any commands that have some args that need to be+# converted and some that don't.++# Commands whose arguments are file paths that need to be translated.+cmds_convert_nonoption_args='|get|put|pull|push|send|apply'++# Commands who's arguments should be left alone.  File paths that+# refer to files in the repo should NOT be converted because they+# are relative paths, which Darcs will handle just fine.  Cygwin+# sometimes makes them absolute paths, which confuses Darcs.+#cmds_no_convert_nonoption_paths='|add|remove|mv|replace|record|whatsnew|changes|setpref|trackdown|amend-record|revert|diff|annotate'++# Commands that don't accept non-option arguments+#cmds_no_nonoption_args='|initialize|tag|check|optimize|rollback|unrecord|unpull|resolve|dist|repair'++# See if we need to convert the non-option args for the current+# command.  This matches some prefix of one of the commands in the+# list.  The match may not be unambiguous, we can rely on Darcs to+# deal with that correctly.+if expr match "$cmds_convert_nonoption_args" ".*|$cmd" > /dev/null; then+   convert_nonoption_args=true+else+   convert_nonoption_args=false+fi++function convert_path() {+   # echo "converting path ${*} ..." >> /tmp/log+   if expr match "$1" '[-@._A-Za-z0-9]*:' > /dev/null; then+      # Some sort of URL or remote ssh pathname ("xxx:/")+      echo "$1"+      # echo "converting path ${*} ... to ${1}" >> /tmp/log+   elif [ "$1" == '.' ]; then+      # Compensate for stupid 'cygpath' behavior.+      echo '.'+      # echo "converting path ${*} ... to ." >> /tmp/log+   else+      cygpath -wl -- "$1"+      # echo "converting path ${*} ... to `cygpath -wl -- ${1}`" >> /tmp/log+   fi+}++declare -a params=("$cmd")++num_nonoption_args=0++while [ $# -gt 0 ]; do+   arg=$1+   shift+   if expr match "$arg" '-' > /dev/null; then+      # It's an option.  Check to see if it's an opaque binary option.++      if expr match "$arg" '.*=' > /dev/null; then+         # The option has an '=' in it.+         opt=`expr match "$arg" '\([^=]*\)'`+         opt_arg=`expr match "$arg" '[^=]*=\(.*\)'`+         if is_opaque_opt "$opt"; then+            true;+         elif is_file_opt "$opt"; then+            opt_arg=`convert_path "$opt_arg"`+         else+            die "darcs-wrapper: I don't think '$opt' accepts an argument." \+                "[ If it does, then there is a bug in the wrapper script. ]"+         fi+         params[${#params[*]}]="$opt=$opt_arg"++      else+         # The option doesn't have an '='+         opt="$arg"+         if is_opaque_opt "$opt"; then+            if [ $# -eq 0 ]; then+               die "darcs-wrapper: I think '$arg' requires an argument." \+                   "[ If it doesn't, then there is a bug in the wrapper script. ]"+            fi+            opt_arg="$1"+            shift+            params[${#params[*]}]="$opt"+            params[${#params[*]}]="$opt_arg"+         elif is_file_opt "$opt"; then+            if [ $# -eq 0 ]; then+               die "darcs-wrapper: I think '$arg' requires an argument." \+                   "[ If it doesn't, then there is a bug in the wrapper script. ]"+            fi+            opt_arg=`convert_path "$1"`+            shift+            params[${#params[*]}]="$opt"+            params[${#params[*]}]="$opt_arg"+         else+            params[${#params[*]}]="$opt"+         fi+      fi++   else+      if $convert_nonoption_args; then+         arg=`convert_path "$arg"`+      fi+      params[${#params[*]}]="$arg"+      (( num_nonoption_args += 1 ))+   fi+done++# DEBUG+if $debug; then+   echo "ARGS:"+   for arg in "${params[@]}"; do+      echo "  arg = '$arg'"+   done+else+   # echo about to exec -a darcs "$darcs_binary" "${params[@]}"+   exec -a darcs "$darcs_binary" "${params[@]}"+fi+
+ contrib/darcs_completion view
@@ -0,0 +1,52 @@+#-*- mode: shell-script;-*-++# darcs command line completion.+# Copyright 2002 "David Roundy" <droundy@abridgegame.org>+#+have darcs &&+_darcs()+{+    local cur+    cur=${COMP_WORDS[COMP_CWORD]}++    COMPREPLY=()++    if (($COMP_CWORD == 1)); then+        COMPREPLY=( $( darcs --commands | grep "^$cur" ) )+        return 0+    fi++    local IFS=$'\n' # So that the following "command-output to array" operation splits only at newlines, not at each space, tab or newline.+    COMPREPLY=( $( darcs ${COMP_WORDS[1]} --list-option | grep "^${cur//./\\.}") )++	# Then, we adapt the resulting strings to be reusable by bash. If we don't+	# do this, in the case where we have two repositories named+	# ~/space in there-0.1 and ~/space in there-0.2, the first completion will+	# give us:+	# bash> darcs push ~/space in there-0.+	# ~/space in there-0.1 ~/space in there-0.2+	# and we have introduced two spaces in the command line (if we try to+	# recomplete that, it won't find anything, as it doesn't know anything+	# starting with "there-0.").+	# printf %q will gracefully add the necessary backslashes.+	#+	# Bash also interprets colon as a separator. If we didn't handle it+	# specially, completing http://example.org/repo from http://e would +	# give us:+	# bash> darcs pull http:http://example.org/repo+	# An option would be to require the user to escape : as \: and we+	# would do the same here. Instead, we return only the part after+	# the last colon that is already there, and thus fool bash. The+	# downside is that bash only shows this part to the user.+    local i=${#COMPREPLY[*]}+    local colonprefixes=${cur%"${cur##*:}"}+    while [ $((--i)) -ge 0 ]; do+      COMPREPLY[$i]=`printf %q "${COMPREPLY[$i]}"`++      COMPREPLY[$i]=${COMPREPLY[$i]#"$colonprefixes"} +    done+    return 0++}+[ "$have" ] && complete -F _darcs -o default darcs+
+ contrib/update_roundup.pl view
@@ -0,0 +1,78 @@+#!/usr/bin/perl++use strict;+use warnings;++# A script to update the status of an issue in a Roundup bug tracker+# based on the format of a darcs patch name.+# It is intended to be run from a darcs posthook.++# The format we look for is:+#   resolved issue123 +# in the first line of the patch. ++use Getopt::Long;++use MIME::Lite;+use XML::Simple;++unless ($ENV{DARCS_PATCHES_XML}) {+    die "DARCS_PATCHES_XML was expected to be set in the environment, but was not found. +          Are you running this from a Darcs 2.0 or newer posthook?"+}++my $xml = eval { XMLin($ENV{DARCS_PATCHES_XML}); };+die "hmmm.. we couldn't parse your XML. The error was: $@"  if $@;++# $xml structure returned looks like this: +#  'patch' => {+#    'resolved issue123: adding t.t' => {+#        'hash' => '20080215033723-20bb4-54f935f89817985a3e98f3de8e8ac9dad5e8e0e5.gz',+#        'inverted' => 'False',+#        'date' => '20080215033723',+#        'author' => 'Mark Stosberg <mark@summersault.com>',+#        'local_date' => 'Thu Feb 14 22:37:23 EST 2008'+#        },+#     'some other patch' => { ... }, ++for my $patch_name (keys %{ $xml->{patch} }) {+    my $issue_re = qr/resolved? \s+ (issue\d+)/msxi;++    next unless ($patch_name =~ $issue_re);+    my $issue = $1;+    my $patch = $xml->{patch}{$patch_name};++    # Using the Command Line would be a simpler alternative. +    # my $out = `roundup-admin -i /var/lib/roundup/trackers/darcs set $issue status=resolved`;+    # warn "unexpected output: $out" if $out;++    my $author = $patch->{author};+    # If the Author name contains an @ sign, we take it to be an e-mail address.+    # Otherwise, we default to darcs-devel as the sender. +    my $email = ($author =~ m/\@/) ? $author : 'darcs-devel@darcs.net';++    my $comment = $patch->{comment} ? "\n$patch->{comment}" : '';++    my $patch_name_minus_status = $patch_name; +    $patch_name_minus_status =~ s/$issue_re(:?\s?)//;++     # Each patches can potentially update the status of a different issue, so generates a different e-mail+    my $msg = MIME::Lite->new(+         From     => $email, +         To      =>'bugs@darcs.net',+         #To       =>'mark@stosberg.com',+         Subject  =>"[$issue] [status=resolved]",+         Type     =>'text/plain',+         Data     => qq!The following patch updated the status of $issue to be resolved:++* $patch_name $comment++!+     );+     $msg->send;+     # An alternative to actually sending, for debugging. +     # use File::Slurp;+     # write_file("msg-$patch->{hash}.out",$msg->as_string);+}++
+ contrib/upload.cgi view
@@ -0,0 +1,126 @@+#!/usr/bin/perl++use strict;+use File::Temp qw/ tempdir tempfile /;++# this is a sample cgi script to accept darcs patches via POST+# it simply takes patches and sends them using sendmail or+# places them in a Maildir style mailbox.++my $tmp_dir;        # temporary directory, when placing patches to maildir+                    # files are linked from $tmp_dir to $maildir+$tmp_dir = "/tmp";++# target email addresses--leave blank to use To: header in patch contents.+my $target_email;++# target repository for patch testing.  Leave blank to use DarcsURL header+# in patch contents.+my $target_repo;++my $sendmail_cmd;   # command to send patches with+$sendmail_cmd = "/usr/sbin/sendmail -i -t $target_email";++my $maildir;        # maildir to put patches to, replace sendmail+#$maildir = "/tmp/maildir";++my $patch_test_cmd; # command to test patches with+$patch_test_cmd = "darcs apply --dry-run --repodir 'TARGETREPO' 'TARGETPATCH'";++my $repo_get_cmd; # command to get testing repo+                  # used only when $target_repo is blank+$repo_get_cmd = "darcs get --lazy --repodir 'TARGETDIR' 'TARGETREPO'";+++sub error_page {+    my ($m) = @_;+    print "Status: 500 Error accepting patch\n";+    print "Content-Type: text/plain\n\n";+    print($m || "There was an error processing your request");+    print "\n";+    exit 0;+}++sub success_page {+    print "Content-Type: text/plain\n\n";+    print "Thank you for your contribution!\n";+    exit 0;+}+++if ($ENV{CONTENT_TYPE} eq 'message/rfc822') {+    my $m = start_message() or error_page("could not create temporary file");+    my $fh = $m->{fh};+    my ($totalbytes, $bytesread, $buffer);+    do {+        $bytesread = read(STDIN, $buffer, 1024);+        print $fh $buffer;+        $totalbytes += $bytesread;+    } while ($bytesread);+    my $r = end_message($m);+    $r ? error_page($r) : success_page();+} elsif ($ENV{CONTENT_TYPE}) {+    error_page("invalid content type, I expect something of message/rfc822");+} else {+    error_page("This url is for accepting darcs patches.");+}++++sub maildir_file {+    my ($tmp_file) = @_;+    my $base_name = sprintf("patch-%d-%d-0000", $$, time());+    my $count = 0;+    until (link("$tmp_file", "$maildir/$base_name")) {+        $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;+        return undef if $count++ > 100;+    }+    return "$maildir/$base_name";+}++sub start_message {+    my ($fh, $fname) = tempfile("$tmp_dir/dpatch".'X'x8, UNLINK => 1) or+        return undef;+    return { fh => $fh, filename => $fname };+}++sub end_message {+    my ($m) = @_;+    close $m->{fh} or return "$!: $m->{filename} - Could not close filehandle";++    unless ($target_repo) {+        # Look for DarcsURL header+        my $darcsurl;+        open(MF,$m->{filename}) or return "$!: $m->{filename} - Could not open file";+        while (<MF>) {+            if (/^DarcsURL: (.+)$/) {+                $darcsurl = $1;+                last;+            }+        }+        close(MF);+        return "Could not find DarcsURL header" unless $darcsurl;++        my $test_dir = tempdir(CLEANUP => 1).'/repo' or+            return "$!: Could not create test directory";+        $repo_get_cmd =~ s/TARGETDIR/$test_dir/;+        $repo_get_cmd =~ s/TARGETREPO/$darcsurl/;+        system("$repo_get_cmd >/dev/null 2>/dev/null") == 0 or+            return "Could not get target repo: '$repo_get_cmd' failed";+        $target_repo = $test_dir;+    }+    $patch_test_cmd =~ s/TARGETREPO/$target_repo/;+    $patch_test_cmd =~ s/TARGETPATCH/$m->{filename}/;+    system("$patch_test_cmd >/dev/null 2>/dev/null") == 0 or+        return "Patch is not valid: '$patch_test_cmd' failed";++    if ($maildir) {+        maildir_file("$m->{filename}") or+            return "$!: Could not create a new file in maildir";+    } else {+        system("$sendmail_cmd < '$m->{filename}'") == 0 or+            return "$!: Could not send mail";+    }++    return 0;+}
darcs.cabal view
@@ -1,5 +1,5 @@ Name:           darcs-version:        2.2.1+version:        2.3.0 License:        GPL License-file:   COPYING Author:         David Roundy <droundy@darcs.net>, <darcs-users@darcs.net>@@ -37,28 +37,25 @@ Tested-with:    GHC==6.8.2  extra-source-files:-  -- template files-  src/Autoconf.hs.in src/ThisVersion.hs.in -   -- C headers   src/*.h src/Crypt/sha2.h   src/win32/send_email.h src/win32/sys/mman.h    -- TODO: factor out these standalone executables to other sections-  src/preproc.hs, src/darcsman.hs, src/unit.lhs,+  src/preproc.hs, src/unit.lhs, -  -- The tools directory would make a sensible 'darcs-tools' package-  tools/zsh_completion_new, tools/zsh_completion_old, tools/darcs_completion,-  tools/cygwin-wrapper.bash, tools/update_roundup.pl, tools/upload.cgi,-  tools/cgi/darcs.cgi.in, tools/cgi/cgi.conf.in, tools/cgi/README.in-  tools/cgi/xslt/*.xslt, tools/cgi/xslt/*.xml, tools/cgi/xslt/*.css,+  -- The contrib directory would make a sensible 'darcs-contrib' package+  contrib/_darcs.zsh, contrib/darcs_completion,+  contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,+  contrib/cgi/darcs.cgi.in, contrib/cgi/cgi.conf.in, contrib/cgi/README.in+  contrib/cgi/xslt/*.xslt, contrib/cgi/xslt/*.xml, contrib/cgi/xslt/*.css,    -- documentation files   src/best_practices.tex, src/building_darcs.tex, src/configuring_darcs.tex,   src/features.tex, src/gpl.tex, src/switching.tex,-  tools/cgi/README.in+  contrib/cgi/README.in -  README+  README, NEWS    -- release data   release/distributed-version, release/distributed-context@@ -67,11 +64,11 @@   Distribution/ShellHarness.hs   tests/repos/*.tgz tests/repos/README   tests/*.sh+  tests/hspwd.hs   tests/network/*.sh   tests/lib   tests/example_binary.png   bugs/*.sh-  bugs/bin/darcs  source-repository head   type:     darcs@@ -86,30 +83,24 @@   --TODO: needs Cabal ticket #342 to allow default True   --      and decide on this automatically -flag libwww-  description: Use libwww for HTTP support.- flag http   description: Use the pure Haskell HTTP package for HTTP support. -flag external-bytestring+-- SUNSET: this should be mandatory after the 2009-07 release is out+flag bytestring   description: Use the external bytestring package. -flag external-zlib+flag zlib   description: Use the external zlib binding package.-  default:     False+  default:     True -flag haskeline-  description: Use the haskeline package for command line editing support.-  default:     False+-- SUNSET: this should be mandatory after the 2009-07 release is out+flag utf8-string+  description: Use the external utf8-string binding package.  flag terminfo   description: Use the terminfo package for enhanced console support. -flag curses-  description: Use libcurses for enhances console support.-  default:     False- flag type-witnesses   description: Use GADT type witnesses.   default:     False@@ -117,8 +108,45 @@ flag color   description: Use ansi color escapes. -flag base3+flag mmap+  description: Compile with mmap support. +flag test+  description: Compile unit tests (requires QuickCheck >= 2.1.0.0).+  default:     False++Executable          witnesses+  main-is:          witnesses.hs+  hs-source-dirs:   src+  include-dirs:     src+  cpp-options:      -DGADT_WITNESSES=1+  -- FIXME...+  c-sources:        src/atomic_create.c+                    src/fpstring.c+                    src/c_compat.c+                    src/maybe_relink.c+                    src/umask.c+                    src/Crypt/sha2.c+  if !flag(type-witnesses)+    buildable: False++  if !flag(zlib)+    extra-libraries:  z++  if os(windows)+    hs-source-dirs: src/win32+    include-dirs:   src/win32+    other-modules:  CtrlC+                    System.Posix+                    System.Posix.Files+                    System.Posix.IO+    cpp-options:    -DWIN32+    c-sources:      src/win32/send_email.c++-- ----------------------------------------------------------------------+-- darcs library+-- ----------------------------------------------------------------------+ Library   hs-source-dirs:   src   include-dirs:     src@@ -142,10 +170,11 @@                     Darcs.Commands.Diff                     Darcs.Commands.Dist                     Darcs.Commands.Get+                    Darcs.Commands.GZCRCs                     Darcs.Commands.Help                     Darcs.Commands.Init                     Darcs.Commands.MarkConflicts-                    Darcs.Commands.Mv+                    Darcs.Commands.Move                     Darcs.Commands.Optimize                     Darcs.Commands.Pull                     Darcs.Commands.Push@@ -163,6 +192,7 @@                     Darcs.Commands.ShowBug                     Darcs.Commands.ShowContents                     Darcs.Commands.ShowFiles+                    Darcs.Commands.ShowIndex                     Darcs.Commands.ShowRepo                     Darcs.Commands.ShowTags                     Darcs.Commands.Tag@@ -178,6 +208,7 @@                     Darcs.FilePathMonad                     Darcs.Flags                     Darcs.Global+                    Darcs.Gorsvet                     Darcs.Hopefully                     Darcs.IO                     Darcs.Lock@@ -256,6 +287,8 @@                     UTF8                     Workaround +  other-modules:    ThisVersion+   c-sources:        src/atomic_create.c                     src/fpstring.c                     src/c_compat.c@@ -277,26 +310,24 @@     cc-options:     -DHAVE_SIGINFO_H    build-depends:   base          < 4,-                   regex-compat >= 0.71 && <= 0.92,-                   mtl          == 1.1.*,-                   parsec       == 2.1.*,+                   regex-compat >= 0.71 && < 0.94,+                   mtl          >= 1.0 && < 1.2,+                   parsec       >= 2.0 && < 3.1,                    html         == 1.0.*,-                   filepath     == 1.1.*+                   filepath     == 1.1.*,+                   haskeline    >= 0.6.1 && < 0.7,+                   hashed-storage >= 0.3.6 && < 0.4    if !os(windows)-    build-depends: unix == 2.3.*-    cpp-options:   -DHAVE_SIGNALS+    build-depends: unix >= 1.0 && < 2.4 -  if flag(base3)-    build-depends: base >= 3,+  build-depends: base >= 3,                    old-time   == 1.0.*,                    directory  == 1.0.*,                    process    == 1.0.*,                    containers >= 0.1 && < 0.3,                    array      >= 0.1 && < 0.3,                    random     == 1.0.*-  else-    build-depends: base < 3    -- We need optimizations, regardless of what Hackage says   ghc-options:      -Wall -O2 -funbox-strict-fields@@ -304,9 +335,10 @@    if flag(curl)     extra-libraries:   curl+    includes:          curl/curl.h     cpp-options:       -DHAVE_CURL     c-sources:         src/hscurl.c-    cc-options:        -DHAVE_CURL -DPACKAGE_VERSION="2.2.1"+    cc-options:        -DHAVE_CURL      if flag(curl-pipelining)       -- curl 7.19.1 has bug-free pipelining@@ -314,43 +346,38 @@         pkgconfig-depends: libcurl >= 7.19.1       cpp-options:       -DCURL_PIPELINING -DCURL_PIPELINING_DEFAULT -  else-    if flag(libwww)-      build-tools:    libwww-config >= 5.0-      c-sources:      src/hslibwww.c-      cc-options:     -DHAVE_LIBWWW -DPACKAGE_VERSION="2.2.1"-      cpp-options:    -DHAVE_LIBWWW-      x-have-libwww:-    else-      if flag(http)-        build-depends:    network == 2.2.*,-                          HTTP    >= 3000.0 && < 3001.1-        cpp-options:      -DHAVE_HTTP -DPACKAGE_VERSION="2.2.1"-        x-have-http:+  if flag(http)+      build-depends:    network == 2.2.*,+                        HTTP    >= 3000.0 && < 4000.1+      cpp-options:      -DHAVE_HTTP+      x-have-http: -  if flag(external-bytestring)+  if !flag(curl) && !flag(http)+      buildable: False++  if flag(mmap) && !os(windows)+    build-depends:    mmap >= 0.2+    cpp-options:      -DHAVE_MMAP++  if flag(bytestring)     build-depends:    bytestring >= 0.9.0 && < 0.10     cpp-options:      -DHAVE_BYTESTRING -  if flag(external-zlib)-    build-depends:    zlib == 0.5.*+  if flag(zlib)+    build-depends:    zlib >= 0.5.1.0 && < 0.6.0.0     cpp-options:      -DHAVE_HASKELL_ZLIB   else     extra-libraries:  z +  if flag(utf8-string)+    build-depends:    utf8-string == 0.3.*+    cpp-options:      -DHAVE_UTF8STRING+   -- The terminfo package cannot be built on Windows.   if flag(terminfo) && !os(windows)-    build-depends:    terminfo == 0.2.* && >= 0.2.2+    build-depends:    terminfo == 0.3.*     cpp-options:      -DHAVE_TERMINFO -  if flag(curses)-    extra-libraries:  curses-    cpp-options:      -DHAVE_CURSES--  if flag(haskeline)-    build-depends:    haskeline == 0.3.* && >= 0.3.1-    cpp-options:      -DHAVE_HASKELINE-   if flag(color)     x-use-color: @@ -375,6 +402,10 @@     GeneralizedNewtypeDeriving,     MultiParamTypeClasses +-- ----------------------------------------------------------------------+-- darcs itself+-- ----------------------------------------------------------------------+ Executable          darcs   main-is:          darcs.hs   hs-source-dirs:   src@@ -390,17 +421,9 @@   ghc-options:      -Wall -O2 -funbox-strict-fields -threaded   ghc-prof-options: -prof -auto-all -  if !flag(external-zlib)+  if !flag(zlib)     extra-libraries:  z -  if os(windows)-    hs-source-dirs: src/win32-    include-dirs:   src/win32-    other-modules:  CtrlC-                    System.Posix-                    System.Posix.Files-                    System.Posix.IO-    cpp-options:    -DWIN32   cc-options:       -D_REENTRANT    if os(windows)@@ -411,37 +434,37 @@                     System.Posix.Files                     System.Posix.IO     cpp-options:    -DWIN32+    c-sources:      src/win32/send_email.c    if os(solaris)     cc-options:     -DHAVE_SIGINFO_H    build-depends:   base          < 4,-                   regex-compat >= 0.71 && <= 0.92,-                   mtl          == 1.1.*,-                   parsec       == 2.1.*,+                   regex-compat >= 0.71 && < 0.94,+                   mtl          >= 1.0 && < 1.2,+                   parsec       >= 2.0 && < 3.1,                    html         == 1.0.*,-                   filepath     == 1.1.*+                   filepath     == 1.1.*,+                   haskeline    >= 0.6.1 && < 0.7,+                   hashed-storage >= 0.3.6 && < 0.4    if !os(windows)-    build-depends: unix == 2.3.*-    cpp-options:   -DHAVE_SIGNALS+    build-depends: unix >= 1.0 && < 2.4 -  if flag(base3)-    build-depends: base >= 3,+  build-depends: base >= 3,                    old-time   == 1.0.*,                    directory  == 1.0.*,                    process    == 1.0.*,                    containers >= 0.1 && < 0.3,                    array      >= 0.1 && < 0.3,                    random     == 1.0.*-  else-    build-depends: base < 3    if flag(curl)     extra-libraries:   curl+    includes:          curl/curl.h     cpp-options:       -DHAVE_CURL     c-sources:         src/hscurl.c-    cc-options:        -DHAVE_CURL -DPACKAGE_VERSION="2.2.1"+    cc-options:        -DHAVE_CURL      if flag(curl-pipelining)       -- curl 7.19.1 has bug-free pipelining@@ -449,44 +472,146 @@         pkgconfig-depends: libcurl >= 7.19.1       cpp-options:       -DCURL_PIPELINING -DCURL_PIPELINING_DEFAULT -  else-    if flag(libwww)-      build-tools:    libwww-config >= 5.0-      c-sources:      src/hslibwww.c-      cc-options:     -DHAVE_LIBWWW -DPACKAGE_VERSION="2.2.1"-      cpp-options:    -DHAVE_LIBWWW-      x-have-libwww:-    else-      if flag(http)-        build-depends:    network == 2.2.*,-                          HTTP    >= 3000.0 && < 3001.1-        cpp-options:      -DHAVE_HTTP -DPACKAGE_VERSION="2.2.1"-        x-have-http:+  if flag(http)+      build-depends:    network == 2.2.*,+                        HTTP    >= 3000.0 && < 4000.1+      cpp-options:      -DHAVE_HTTP+      x-have-http: -  if flag(external-bytestring)+  if !flag(curl) && !flag(http)+      buildable: False++  if flag(mmap) && !os(windows)+    build-depends:    mmap >= 0.2+    cpp-options:      -DHAVE_MMAP++  if flag(bytestring)     build-depends:    bytestring >= 0.9.0 && < 0.10     cpp-options:      -DHAVE_BYTESTRING -  if flag(external-zlib)-    build-depends:    zlib == 0.5.*+  if flag(zlib)+    build-depends:    zlib >= 0.5.1.0 && < 0.6.0.0     cpp-options:      -DHAVE_HASKELL_ZLIB   else     extra-libraries:  z +  if flag(utf8-string)+    build-depends:    utf8-string == 0.3.*+    cpp-options:      -DHAVE_UTF8STRING+   -- The terminfo package cannot be built on Windows.   if flag(terminfo) && !os(windows)-    build-depends:    terminfo == 0.2.* && >= 0.2.2+    build-depends:    terminfo == 0.3.*     cpp-options:      -DHAVE_TERMINFO -  if flag(curses)-    extra-libraries:  curses-    cpp-options:      -DHAVE_CURSES+  if flag(color)+    x-use-color: -  -- Haskeline has some bugs on Windows with international keyboards.  -  if flag(haskeline) && !os(windows)-    build-depends:    haskeline == 0.3.* && >= 0.3.1-    cpp-options:      -DHAVE_HASKELINE+  extensions:+    CPP,+    ForeignFunctionInterface,+    BangPatterns,+    PatternGuards,+    MagicHash,+    UndecidableInstances,+    DeriveDataTypeable,+    GADTs,+    TypeOperators,+    ExistentialQuantification,+    FlexibleContexts,+    FlexibleInstances,+    ScopedTypeVariables,+    KindSignatures,+    TypeSynonymInstances,+    Rank2Types,+    RankNTypes,+    GeneralizedNewtypeDeriving,+    MultiParamTypeClasses +-- ----------------------------------------------------------------------+-- unit test driver+-- ----------------------------------------------------------------------++Executable          unit+  main-is:          unit.lhs+  hs-source-dirs:   src+  include-dirs:     src+  c-sources:        src/atomic_create.c+                    src/fpstring.c+                    src/c_compat.c+                    src/maybe_relink.c+                    src/umask.c+                    src/Crypt/sha2.c++  -- We need optimizations, regardless of what Hackage says+  ghc-options:      -Wall -O2 -funbox-strict-fields -threaded+  ghc-prof-options: -prof -auto-all++  if !flag(test)+    buildable: False+  else+    buildable: True+    build-depends:   base          < 4,+                     regex-compat >= 0.71 && < 0.94,+                     mtl          >= 1.0 && < 1.2,+                     parsec       >= 2.0 && < 3.1,+                     html         == 1.0.*,+                     filepath     == 1.1.*,+                     QuickCheck   >= 2.1.0.0,+                     HUnit        >= 1.0,+                     test-framework             >= 0.2.2,+                     test-framework-hunit       >= 0.2.2,+                     test-framework-quickcheck2 >= 0.2.2+++  if !flag(zlib)+    extra-libraries:  z++  cc-options:       -D_REENTRANT++  if os(windows)+    hs-source-dirs: src/win32+    include-dirs:   src/win32+    other-modules:  CtrlC+                    System.Posix+                    System.Posix.Files+                    System.Posix.IO+    cpp-options:    -DWIN32+    c-sources:      src/win32/send_email.c++  if os(solaris)+    cc-options:     -DHAVE_SIGINFO_H++  if !os(windows)+    build-depends: unix >= 1.0 && < 2.4++  build-depends: base >= 3,+                   old-time   == 1.0.*,+                   directory  == 1.0.*,+                   process    == 1.0.*,+                   containers >= 0.1 && < 0.3,+                   array      >= 0.1 && < 0.3,+                   random     == 1.0.*++  if flag(mmap) && !os(windows)+    build-depends:    mmap >= 0.2+    cpp-options:      -DHAVE_MMAP++  if flag(bytestring)+    build-depends:    bytestring >= 0.9.0 && < 0.10+    cpp-options:      -DHAVE_BYTESTRING++  if flag(zlib)+    build-depends:    zlib >= 0.5.1.0 && < 0.6.0.0+    cpp-options:      -DHAVE_HASKELL_ZLIB+  else+    extra-libraries:  z++  -- The terminfo package cannot be built on Windows.+  if flag(terminfo) && !os(windows)+    build-depends:    terminfo == 0.3.*+    cpp-options:      -DHAVE_TERMINFO+   if flag(color)     x-use-color: @@ -510,3 +635,4 @@     RankNTypes,     GeneralizedNewtypeDeriving,     MultiParamTypeClasses+    OverlappingInstances
release/distributed-context view
@@ -1,1 +1,1 @@-Just "\nContext:\n\n[TAG 2.2.1\nPetr Rockai <me@mornfall.net>**20090214071133\n Ignore-this: f4a1d192bc93490e498eed18c1165d8d\n] \n"+Just "\nContext:\n\n[TAG 2.3.0\nPetr Rockai <me@mornfall.net>**20090723115125\n Ignore-this: e326d4ddff92c578e8fe8a3c23d00193\n] \n"
− src/Autoconf.hs.in 
@@ -1,71 +0,0 @@------ System dependent information generated by Autoconf.------ @configure_input@----{-# LANGUAGE CPP #-}-{-# OPTIONS -cpp #-}--module Autoconf ( have_libcurl, have_libwww, have_HTTP,-                  use_color, use_mmap, darcs_version, sendmail_path, have_sendmail,-                  have_mapi, diff_program,-                  path_separator, big_endian,-                ) where--import ThisVersion ( darcs_version )--{-# INLINE have_libcurl #-}-have_libcurl :: Bool-#ifdef HAVE_CURL-have_libcurl = True-#else-have_libcurl = False-#endif--{-# INLINE have_libwww #-}-have_libwww :: Bool-#ifdef HAVE_LIBWWW-have_libwww = True-#else-have_libwww = False-#endif--{-# INLINE have_HTTP #-}-have_HTTP :: Bool-have_HTTP = @HAVE_HTTP@--{-# INLINE use_color #-}-use_color :: Bool-use_color = @USE_COLOR@--{-# INLINE use_mmap #-}-use_mmap :: Bool-use_mmap = @USE_MMAP@--{-# INLINE sendmail_path #-}-sendmail_path :: String-sendmail_path = "@SENDMAIL@"--{-# INLINE have_sendmail #-}-have_sendmail :: Bool-have_sendmail = @HAVE_SENDMAIL@--{-# INLINE have_mapi #-}-have_mapi :: Bool-have_mapi = @HAVE_MAPI@--{-# INLINE diff_program #-}-diff_program :: String-diff_program = "@DIFF@"--{-# INLINE path_separator #-}-path_separator :: Char-#ifdef WIN32-path_separator = '\\'-#else-path_separator = '/'-#endif--{-# INLINE big_endian #-}-big_endian :: Bool-big_endian = @BIGENDIAN@
src/ByteStringUtils.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, ForeignFunctionInterface, CPP #-}+{-# LANGUAGE BangPatterns, ForeignFunctionInterface, CPP, ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -26,6 +26,12 @@         gzWriteFilePS,         gzWriteFilePSs, +        -- gzip handling+        isGZFile,+#ifdef HAVE_HASKELL_ZLIB+        gzDecompress,+#endif+         -- list utilities         ifHeadThenTail,         dropSpace,@@ -46,30 +52,23 @@         intercalate     ) where -import Autoconf                 ( use_mmap )-+import Prelude hiding ( catch ) import qualified Data.ByteString            as B import qualified Data.ByteString.Char8      as BC-#if __GLASGOW_HASKELL__ > 606 import qualified Data.ByteString.Internal   as BI import Data.ByteString (intercalate, uncons) import Data.ByteString.Internal (fromForeignPtr)-#else-import qualified Data.ByteString.Base     as BI-#endif +#if defined (HAVE_MMAP) || ! defined (HAVE_HASKELL_ZLIB)+import Control.Exception        ( catch )+#endif import System.IO import System.IO.Unsafe         ( unsafePerformIO ) -#if __GLASGOW_HASKELL__ > 606 import Foreign.Storable         ( peekElemOff, peek )-#else-import Foreign.Storable         ( peekElemOff, peek, peekByteOff )-import Data.List                ( intersperse )-#endif import Foreign.Marshal.Alloc    ( free ) import Foreign.Marshal.Array    ( mallocArray, peekArray, advancePtr )-import Foreign.C.Types          ( CInt, CSize )+import Foreign.C.Types          ( CInt )  import Data.Bits                ( rotateL ) import Data.Char                ( chr, ord, isSpace )@@ -77,13 +76,12 @@ import Data.Int                 ( Int32 ) import Control.Monad            ( when ) -import Foreign.Ptr              ( nullPtr, plusPtr, Ptr )-import Foreign.ForeignPtr       ( ForeignPtr, withForeignPtr )--#if defined(__GLASGOW_HASKELL__)-import qualified Foreign.Concurrent as FC ( newForeignPtr )-import System.Posix             ( handleToFd )+#ifndef HAVE_HASKELL_ZLIB+import Foreign.Ptr              ( nullPtr )+import Foreign.ForeignPtr       ( ForeignPtr ) #endif+import Foreign.Ptr              ( plusPtr, Ptr )+import Foreign.ForeignPtr       ( withForeignPtr )  #ifdef DEBUG_PS import Foreign.ForeignPtr       ( addForeignPtrFinalizer )@@ -93,13 +91,22 @@ #if HAVE_HASKELL_ZLIB import qualified Data.ByteString.Lazy as BL import qualified Codec.Compression.GZip as GZ+import qualified Codec.Compression.Zlib.Internal as ZI+import Darcs.Global ( addCRCWarning ) #else import Foreign.C.String ( CString, withCString ) #endif +#ifdef HAVE_MMAP+import System.IO.MMap( mmapFileByteString )+import System.Mem( performGC )+import System.Posix.Files( fileSize, getSymbolicLinkStatus )+#endif+ -- ----------------------------------------------------------------------------- -- obsolete debugging code +# ifndef HAVE_HASKELL_ZLIB debugForeignPtr :: ForeignPtr a -> String -> IO () #ifdef DEBUG_PS foreign import ccall unsafe "static fpstring.h debug_alloc" debug_alloc@@ -113,6 +120,7 @@ #else debugForeignPtr _ _ = return () #endif+#endif  -- ----------------------------------------------------------------------------- -- unsafeWithInternals@@ -162,32 +170,6 @@     Just (w, t) | w == c    -> Just t     _                       -> Nothing -#if __GLASGOW_HASKELL__ <= 606--- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing--- if it is empty.-uncons :: B.ByteString -> Maybe (Word8, B.ByteString)-uncons (BI.PS x s l)-    | l <= 0    = Nothing-    | otherwise = Just (BI.inlinePerformIO $ withForeignPtr x-                                        $ \p -> peekByteOff p s,-                        BI.PS x (s+1) (l-1))-{-# INLINE uncons #-}--- | /O(1)/ Build a ByteString from a ForeignPtr-fromForeignPtr :: ForeignPtr Word8-               -> Int -- ^ Offset-               -> Int -- ^ Length-               -> B.ByteString-fromForeignPtr fp s l = BI.PS fp s l-{-# INLINE fromForeignPtr #-}--- | /O(n)/ The 'intercalate' function takes a 'ByteString' and a list of--- 'ByteString's and concatenates the list after interspersing the first--- argument between each element of the list.-intercalate :: B.ByteString -> [B.ByteString] -> B.ByteString-intercalate s = B.concat . (intersperse s)-{-# INLINE [1] intercalate #-}-#endif-- ------------------------------------------------------------------------ -- A reimplementation of Data.ByteString.Char8.dropSpace, but -- specialised to darcs' need for a 4 way isspace.@@ -361,10 +343,43 @@ -- ----------------------------------------------------------------------------- -- gzReadFilePS --- | Read an entire file, which may or may not be gzip compressed, directly--- into a 'B.ByteString'.+#ifdef HAVE_HASKELL_ZLIB -#ifndef HAVE_HASKELL_ZLIB+-- |Decompress the given bytestring into a lazy list of chunks, along with a boolean+-- flag indicating (if True) that the CRC was corrupted.+-- Inspecting the flag will cause the entire list of chunks to be evaluated (but if+-- you throw away the list immediately this should run in constant space).+gzDecompress :: Maybe Int -> BL.ByteString -> ([B.ByteString], Bool)+gzDecompress mbufsize =+    -- This is what the code would be without the bad CRC recovery logic:+    -- return . BL.toChunks . GZ.decompressWith decompressParams+    toListWarn . ZI.decompressWithErrors ZI.GZip decompressParams+  where+        decompressParams = case mbufsize of+                              Just bufsize -> GZ.defaultDecompressParams { GZ.decompressBufferSize = bufsize }+                              Nothing -> GZ.defaultDecompressParams++        toListWarn :: ZI.DecompressStream -> ([B.ByteString], Bool)+        toListWarn = foldDecompressStream (\x ~(xs, b) -> (x:xs, b)) ([], False) handleBad++        -- cut and paste from Zlib since it's not currently exported (interface not yet certain)+        foldDecompressStream :: (B.ByteString -> a -> a) -> a+                             -> (ZI.DecompressError -> String -> a)+                             -> ZI.DecompressStream -> a+        foldDecompressStream chunk end err = fold+                   where+                       fold ZI.StreamEnd               = end+                       fold (ZI.StreamChunk bs stream) = chunk bs (fold stream)+                       fold (ZI.StreamError code msg)  = err code msg++        -- For a while a bug in darcs caused gzip files with good data but bad CRCs to be+        -- produced. Trap bad CRC messages, run the specified action to report that it happened,+        -- but continue on the assumption that the data is valid.+        handleBad ZI.DataError "incorrect data check" = ([], True)+        handleBad _ msg = error msg++#else+ foreign import ccall unsafe "static zlib.h gzopen" c_gzopen     :: CString -> CString -> IO (Ptr ()) foreign import ccall unsafe "static zlib.h gzclose" c_gzclose@@ -373,36 +388,38 @@     :: Ptr () -> Ptr Word8 -> CInt -> IO CInt foreign import ccall unsafe "static zlib.h gzwrite" c_gzwrite     :: Ptr () -> Ptr Word8 -> CInt -> IO CInt+ #endif -gzReadFilePS :: FilePath -> IO B.ByteString-gzReadFilePS f = do+isGZFile :: FilePath -> IO (Maybe Int)+isGZFile f = do     h <- openBinaryFile f ReadMode     header <- B.hGet h 2     if header /= BC.pack "\31\139"        then do hClose h-               mmapFilePS f+               return Nothing        else do hSeek h SeekFromEnd (-4)                len <- hGetLittleEndInt h                hClose h+               return (Just len)++-- | Read an entire file, which may or may not be gzip compressed, directly+-- into a 'B.ByteString'.+gzReadFilePS :: FilePath -> IO B.ByteString+gzReadFilePS f = do+    mlen <- isGZFile f+    case mlen of+       Nothing -> mmapFilePS f+       Just len -> #ifdef HAVE_HASKELL_ZLIB-               -- Passing the length to GZ.decompressWith means-               -- that BL.toChunks only produces one chunk, which in turn-               -- means that B.concat won't need to copy data.+            do -- Passing the length to gzDecompress means that it produces produces one chunk,+               -- which in turn means that B.concat won't need to copy data.                -- If the length is wrong this will just affect efficiency, not correctness-               let decompress = GZ.decompressWith GZ.defaultDecompressParams {-                                  GZ.decompressBufferSize = len-                                }-               fmap (B.concat . BL.toChunks . decompress) $-#ifdef HAVE_OLD_BYTESTRING-                        -- bytestring < 0.9.1 had a bug where it did not know to close handles upon EOF-                        -- performance would be better with a newer bytestring and lazy-                        -- readFile below -- ratify readFile: comment-                        fmap (BL.fromChunks . (:[])) $-                        B.readFile f  -- ratify readFile: immediately consumed-#else-                        BL.readFile f -- ratify readFile: immediately consumed by the conversion to a strict bytestring-#endif+               let doDecompress buf = let (res, bad) = gzDecompress (Just len) buf+                                      in do when bad $ addCRCWarning f+                                            return res+               compressed <- (BL.fromChunks . return) `fmap` mmapFilePS f+               B.concat `fmap` doDecompress compressed #else                withCString f $ \fstr-> withCString "rb" $ \rb-> do                  gzf <- c_gzopen fstr rb@@ -466,58 +483,18 @@ -- the file is assumed to be ISO-8859-1.  mmapFilePS :: FilePath -> IO B.ByteString-mmapFilePS f = if use_mmap-               then do (fp,l) <- mmap f-                       return $ fromForeignPtr fp 0 l-               else B.readFile f--#if defined(__GLASGOW_HASKELL__)-foreign import ccall unsafe "static fpstring.h my_mmap" my_mmap-    :: CSize -> CInt -> IO (Ptr Word8)-foreign import ccall unsafe "static sys/mman.h munmap" c_munmap-    :: Ptr Word8 -> CSize -> IO CInt-foreign import ccall unsafe "static unistd.h close" c_close-    :: CInt -> IO CInt-#endif--mmap :: FilePath -> IO (ForeignPtr Word8, Int)-mmap f = do-    h <- openBinaryFile f ReadMode-    l <- fromIntegral `fmap` hFileSize h-    -- Don't bother mmaping small files because each mmapped file takes up-    -- at least one full VM block.-    if l < mmap_limit-       then do thefp <- BI.mallocByteString l-               debugForeignPtr thefp $ "mmap short file "++f-               withForeignPtr thefp $ \p-> hGetBuf h p l-               hClose h-               return (thefp, l)-       else do-#if defined(__GLASGOW_HASKELL__)-               fd <- fromIntegral `fmap` handleToFd h-               p <- my_mmap (fromIntegral l) fd-               fp <- if p == nullPtr-                     then+#ifdef HAVE_MMAP+mmapFilePS f = do+  x <- mmapFileByteString f Nothing+   `catch` (\_ -> do+                     size <- fileSize `fmap` getSymbolicLinkStatus f+                     if size == 0+                        then return B.empty+                        else performGC >> mmapFileByteString f Nothing)+  return x #else-               fp <--#endif-                          do thefp <- BI.mallocByteString l-                             debugForeignPtr thefp $ "mmap short file "++f-                             withForeignPtr thefp $ \p' -> hGetBuf h p' l-                             return thefp-#if defined(__GLASGOW_HASKELL__)-                     else do-                             fp <- FC.newForeignPtr p-                                   (do {c_munmap p $ fromIntegral l;-                                        return (); })-                             debugForeignPtr fp $ "mmap "++f-                             return fp-               c_close fd+mmapFilePS = B.readFile #endif-               hClose h-               return (fp, l)-    where mmap_limit = 16*1024-  -- ------------------------------------------------------------------------- -- fromPS2Hex
src/Crypt/SHA256.hs view
@@ -18,11 +18,7 @@ import Foreign.C.Types import Numeric (showHex) import Foreign.C.String ( withCString )-#if __GLASGOW_HASKELL__ > 606 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-#else-import Data.ByteString.Base (unsafeUseAsCStringLen)-#endif import qualified Data.ByteString as B  sha256sum :: B.ByteString -> String
src/Darcs/ArgumentDefaults.lhs view
@@ -53,7 +53,7 @@ flags with \verb|ALL|.  \begin{tabular}{ll}-{\tt \verb!~/.darcs/defaults!} & provides defaults for this user account \\+{\tt \verb!~/.darcs/defaults!} & provides defaults for this user account, on MS Windows~\ref{ms_win} \\ {\tt \verb!repo/_darcs/prefs/defaults!} & provides defaults for one project,\\   & overrules changes per user \\ \end{tabular}@@ -110,8 +110,8 @@ \end{verbatim}  Also, a global preferences file can be created with the name-\verb!.darcs/defaults! in your home directory. Options present there will-be added to the repository-specific preferences.+\verb!.darcs/defaults! in your home directory, on MS Windows~\ref{ms_win}. +Options present there will be added to the repository-specific preferences. If they conflict with repository-specific options, the repository-specific ones will take precedence.
src/Darcs/Arguments.lhs view
@@ -22,14 +22,14 @@ #include "gadts.h"  module Darcs.Arguments ( DarcsFlag( .. ), flagToString,+                         maxCount,                          isin, arein,                          definePatches, defineChanges,                          fixFilePathOrStd, fixUrl,                          fixSubPaths, areFileArgs,                          DarcsOption( .. ), option_from_darcsoption,                          help, list_options, list_files,-                         help_on_match,-                         any_verbosity, disable,+                         any_verbosity, disable, restrict_paths,                          notest, test, working_repo_dir,                          testByDefault,                          remote_repo,@@ -44,6 +44,7 @@                          recursive, inventory_choices, get_inventory_choices,                          askdeps, ignoretimes, lookforadds,                          ask_long_comment, sendmail_cmd,+                         environmentHelpSendmail,                          sign, verify, edit_description,                          reponame, tagname, creatorhash,                          apply_conflict_options, reply,@@ -55,6 +56,7 @@                          applyas, human_readable,                          changes_reverse, only_to_files,                          changes_format, match_one_context, match_one_nontag,+                         match_maxcount,                          send_to_context,                          get_context,                          pipe_interactive, all_interactive,@@ -79,8 +81,9 @@                          umask_option,                          store_in_memory,                          patch_select_flag,-                         network_options,-                         allow_unrelated_repos+                         network_options, no_cache,+                         allow_unrelated_repos,+                         check_or_repair, just_this_repo                       ) where import System.Console.GetOpt import System.Directory ( doesDirectoryExist )@@ -97,8 +100,8 @@ import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO ) #endif -import Darcs.Hopefully ( PatchInfoAnd, info )-import Darcs.Patch ( RepoPatch, Patchy, showNicely, description )+import Darcs.Hopefully ( PatchInfoAnd, info, hopefullyM )+import Darcs.Patch ( RepoPatch, Patchy, showNicely, description, xml_summary ) import Darcs.Patch.Info ( to_xml ) import Darcs.Ordered ( FL, mapFL ) import qualified Darcs.Patch ( summary )@@ -111,12 +114,13 @@                         ioAbsolute, ioAbsoluteOrStd,                         makeAbsolute, makeAbsoluteOrStd, rootDirectory ) import Darcs.Patch.MatchData ( patch_match )-import Darcs.Flags ( DarcsFlag(..) )+import Darcs.Flags ( DarcsFlag(..), maxCount ) import Darcs.Repository ( slurp_pending, withRepository, ($-) ) import Darcs.Repository.HashedRepo ( slurp_all_but_darcs ) import Darcs.SlurpDirectory ( list_slurpy ) import Darcs.Global ( darcsdir )-import Printer ( Doc, putDocLn, text, vsep, ($$), vcat )+import Printer ( Doc, putDocLn, text, vsep, ($$), vcat, insert_before_lastline,+                 prefix ) import URL ( pipeliningEnabledByDefault ) #include "impossible.h" @@ -139,7 +143,6 @@ getContent ListOptions = NoContent getContent Test = NoContent getContent NoTest = NoContent-getContent HelpOnMatch = NoContent getContent OnlyChangesToFiles = NoContent getContent LeaveTestDir = NoContent getContent NoLeaveTestDir = NoContent@@ -161,6 +164,7 @@ getContent (UpToPatch s) = StringContent s getContent (TagName s) = StringContent s getContent (LastN s) = StringContent (show s)+getContent (MaxCount s) = StringContent (show s) getContent (OneTag s) = StringContent s getContent (AfterTag s) = StringContent s getContent (UpToTag s) = StringContent s@@ -286,6 +290,9 @@ getContent (PrehookCmd s) = StringContent s getContent (UMask s) = StringContent s getContent AllowUnrelatedRepos = NoContent+getContent Check = NoContent+getContent Repair = NoContent+getContent JustThisRepo = NoContent  get_content :: DarcsFlag -> Maybe String get_content f = do StringContent s <- Just $ getContent f@@ -379,7 +386,7 @@ option_from_darcsoption wd (DarcsAbsPathOption a b c n h) = [Option a b (ReqArg (c . makeAbsolute wd) n) h] option_from_darcsoption wd (DarcsOptAbsPathOption a b d c n h) = [Option a b (OptArg (c . makeAbsolute wd . fromMaybe d) n) h] --- | 'concat_option' creates a DarcsMultipleChoicOption from a list of+-- | 'concat_option' creates a DarcsMultipleChoiceOption from a list of -- option, flattening any DarcsMultipleChoiceOption in the list. concat_options :: [DarcsOption] -> DarcsOption concat_options os = DarcsMultipleChoiceOption $ concatMap from_option os@@ -460,6 +467,7 @@ working_repo_dir :: DarcsOption possibly_remote_repo_dir :: DarcsOption disable :: DarcsOption+restrict_paths :: DarcsOption  pipe_interactive, all_pipe_interactive, all_interactive, all_patches, interactive, pipe,   human_readable, diffflags, allow_problematic_filenames, noskip_boring,@@ -472,7 +480,7 @@   unified, summary, uncompress_nocompress, subject, in_reply_to,   nocompress, match_several_or_range, match_several_or_last,   author, askdeps, lookforadds, ignoretimes, test, notest, help, force_replace,-  help_on_match, allow_unrelated_repos,+  allow_unrelated_repos,   match_one, match_range, match_several, fancy_move_add, sendmail_cmd,   logfile, rmlogfile, leave_test_dir, from_opt, set_default @@ -500,9 +508,6 @@ \begin{code} help = DarcsNoArgOption ['h'] ["help"] Help        "shows brief description of command and its arguments"--help_on_match = DarcsNoArgOption [] ["match"] HelpOnMatch-       "shows a summary of how to use patch matching rules" \end{code}  \begin{options}@@ -533,7 +538,7 @@ Many commands also accept the \verb!--debug! option, which causes darcs to generate additional output that may be useful for debugging its behavior, but which otherwise would not be interesting. Option \verb!--debug-http! makes darcs output debugging-info for curl and libwww.+info for libcurl. \begin{code} any_verbosity :: [DarcsOption] any_verbosity =[DarcsMultipleChoiceOption@@ -542,7 +547,7 @@                  DarcsNoArgOption [] ["debug-verbose"] DebugVerbose                  "give debug and verbose output",                  DarcsNoArgOption [] ["debug-http"] DebugHTTP-                 "give debug output for curl and libwww",+                 "give debug output for libcurl",                  DarcsNoArgOption ['v'] ["verbose"] Verbose                  "give verbose output",                  DarcsNoArgOption ['q'] ["quiet"] Quiet@@ -668,11 +673,9 @@  __last = DarcsArgOption [] ["last"] lastn "NUMBER"          "select the last NUMBER patches"-    where lastn s = if and (map isDigit s)-                    then LastN (read s)-                    else LastN (-1)+    where lastn = LastN . number_string -__index = DarcsArgOption ['n'] ["index"] indexrange "N-M" "select a range of patches"+__index = DarcsArgOption ['n'] ["index"] indexrange "N" "select one patch"     where indexrange s = if all isDigit s                          then PatchIndexRange (read s) (read s)                          else PatchIndexRange 0 0@@ -687,6 +690,12 @@                          else PatchIndexRange 0 0           isokay c = isDigit c || c == '-' +match_maxcount :: DarcsOption+match_maxcount = DarcsArgOption [] ["max-count"] mc "NUMBER"+         "return only NUMBER results"+    where mc = MaxCount . number_string++ -- | 'get_context' takes a list of flags and returns the context -- specified by @Context c@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--context=FILE@@@ -773,7 +782,7 @@ \verb!_darcs/prefs/author! file as described in section~\ref{author_prefs}.  Also, a global author file can be created in your home directory with the name-\verb!.darcs/author!.  This file overrides the+\verb!.darcs/author!, on MS Windows~\ref{ms_win}.  This file overrides the contents of the environment variables, but a repository-specific author file overrides the global author file. @@ -803,16 +812,19 @@     Nothing -> do       aminrepo <- doesDirectoryExist (darcsdir++"/prefs")       if aminrepo then do-          putStr "Darcs needs to know what name (conventionally an email "-          putStr "address) to use as the\npatch author, e.g. 'Fred Bloggs "-          putStr "<fred@bloggs.invalid>'.  If you provide one\nnow "-          putStr ("it will be stored in the file '"++darcsdir++"/prefs/author' and ")-          putStr "used as a default\nin the future.  To change your preferred "-          putStr "author address, simply delete or edit\nthis file.\n\n"+          putDocLn $+            text "Each patch is attributed to its author, usually by email address (for" $$+            text "example, `Fred Bloggs <fred@example.net>').  Darcs could not determine" $$+            text "your email address, so you will be prompted for it." $$+            text "" $$+            text ("Your address will be stored in " ++ darcsdir ++ "/prefs/author.") $$+            text "It will be used for all patches recorded in this repository." $$+            text "If you move that file to ~/.darcs/author, it will be used for patches" $$+            text "you record in ALL repositories."           add <- askUser "What is your email address? "           writeFile (darcsdir++"/prefs/author") add           return add-        else do askUser "What is your email address (e.g. John Doe <a@b.com>)? "+        else askUser "What is your email address (e.g. Fred Bloggs <fred@example.net>)? "  -- | 'get_easy_author' tries to get the author name first from the repository preferences, -- then from global preferences, then from environment variables. Returns 'Nothing' if it@@ -1080,11 +1092,9 @@ -- | @'showFriendly' flags patch@ returns a 'Doc' representing the right -- way to show @patch@ given the list @flags@ of flags darcs was invoked with. showFriendly :: Patchy p => [DarcsFlag] -> p C(x y) -> Doc-showFriendly opts p = if Verbose `elem` opts-                      then showNicely p-                      else if Summary `elem` opts-                           then Darcs.Patch.summary p-                           else description p+showFriendly opts p | Verbose `elem` opts = showNicely p+                    | Summary `elem` opts = Darcs.Patch.summary p+                    | otherwise           = description p  -- | @'print_dry_run_message_and_exit' action opts patches@ prints a string -- representing the action that would be taken if the @--dry-run@ option@@ -1105,11 +1115,21 @@           putDocLn $ put_mode      where put_mode = if XMLOutput `elem` opts                       then (text "<patches>" $$-                            vcat (mapFL (to_xml . info) patches) $$+                            vcat (mapFL (indent . xml_info) patches) $$                             text "</patches>")                       else (vsep $ mapFL (showFriendly opts) patches)            putInfo = if XMLOutput `elem` opts then \_ -> return () else putDocLn+           xml_info pl+              | Summary `elem` opts = xml_with_summary pl+              | otherwise = (to_xml . info) pl+            +           xml_with_summary hp+               | Just p <- hopefullyM hp = insert_before_lastline+                                            (to_xml $ info hp) (indent $ xml_summary p)+           xml_with_summary hp = to_xml (info hp)+           indent = prefix "    " + \end{code}  \input{Darcs/Resolution.lhs}@@ -1263,23 +1283,31 @@ \begin{options} --sendmail-command \end{options}--\label{env:SENDMAIL}--Several commands send email. The user can determine which mta to-use with the \verb!--sendmail-command! switch. For repetitive usage-of a specific sendmail command it is also possible to set the-environment variable \verb!SENDMAIL!. If there is no command line-switch given \verb!SENDMAIL! will be used if present.+\darcsEnv{SENDMAIL}  \begin{code} sendmail_cmd = DarcsArgOption [] ["sendmail-command"] SendmailCmd "COMMAND" "specify sendmail command" +environmentHelpSendmail :: ([String], [String])+environmentHelpSendmail = (["SENDMAIL"], [+ "On Unix, the `darcs send' command relies on sendmail(8).  The",+ "`--sendmail-command' or $SENDMAIL environment variable can be used to",+ "provide an explicit path to this program; otherwise the standard",+ "locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."])+-- FIXME: mention the following also:+-- * sendmail(8) is not sendmail-specific;+-- * nowadays, desktops often have no MTA or an unconfigured MTA --+--   which is awful, because it accepts mail but doesn't relay it;+-- * in this case, can be a sendmail(8)-emulating wrapper on top of an+--   MUA that sends mail directly to a smarthost; and+-- * on a multi-user system without an MTA and on which you haven't+--   got root, can be msmtp.+ -- |'get_sendmail_cmd' takes a list of flags and returns the sendmail command -- to be used by @darcs send@. Looks for a command specified by -- @SendmailCmd \"command\"@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@--- Alternatively the user can set @$SENDMAIL@ which will be used as a fallback if present.+-- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a fallback if present. get_sendmail_cmd :: [DarcsFlag] -> IO String  get_sendmail_cmd (SendmailCmd a:_) = return a get_sendmail_cmd (_:flags) = get_sendmail_cmd flags@@ -1446,8 +1474,8 @@ --http-pipelining, --no-http-pipelining \end{options} -When compiled with libwww or curl (version 7.18.0 and above), darcs can-use HTTP pipelining. It is enabled by default for libwww and curl+When compiled with libcurl (version 7.18.0 and above), darcs can+use HTTP pipelining. It is enabled by default for libcurl (version 7.19.1 and above). This option will make darcs enable or disable HTTP pipelining, overwriting default. Note that if HTTP pipelining is really used depends on the server.@@ -1470,14 +1498,18 @@                            pipelining_description,       DarcsNoArgOption [] ["no-http-pipelining"] NoHTTPPipelining                            no_pipelining_description],-     DarcsNoArgOption [] ["no-cache"] NoCache-                          "don't use patch caches"]+      no_cache+     ]     where pipelining_description =               "enable HTTP pipelining"++               (if pipeliningEnabledByDefault then " [DEFAULT]" else "")           no_pipelining_description =               "disable HTTP pipelining"++               (if pipeliningEnabledByDefault then "" else " [DEFAULT]")++no_cache :: DarcsOption+no_cache = DarcsNoArgOption [] ["no-cache"] NoCache+                          "don't use patch caches" \end{code} \begin{options} --umask@@ -1494,6 +1526,34 @@ \end{code}  \begin{options}+--dont-restrict-paths, --restrict-paths+\end{options}+By default darcs is only allowed to manage and modify files and directories+contained inside the current repository and not being part of any darcs+repository's meta data (including the current one). This is mainly for+security, to protect you from spoofed patches modifying arbitrary files+with sensitive data---say, in your home directory---or tampering with any+repository's meta data to switch off this safety guard.++But sometimes you may want to manage a group of ``sub'' repositories'+preference files with a global repository, or use darcs in some other+advanced way. The best way is probably to put+\verb!ALL dont-restrict-paths! in \verb!_darcs/prefs/defaults!. This turns+off all sanity checking for file paths in patches.++Path checking can be temporarily turned on with \verb!--restrict-paths! on+the command line, when pulling or applying unknown patches.++\begin{code}+restrict_paths =+    DarcsMultipleChoiceOption+    [DarcsNoArgOption [] ["restrict-paths"] RestrictPaths+     "don't allow darcs to touch external files or repo metadata",+     DarcsNoArgOption [] ["dont-restrict-paths"] DontRestrictPaths+     "allow darcs to modify any file or directory (unsafe)"]+\end{code}++\begin{options} --allow-unrelated-repos \end{options} By default darcs checks and warns user if repositories are unrelated when@@ -1503,7 +1563,51 @@ allow_unrelated_repos =     DarcsNoArgOption [] ["ignore-unrelated-repos"] AllowUnrelatedRepos                          "do not check if repositories are unrelated"+\end{code} +\begin{code}+just_this_repo :: DarcsOption+\end{code}++\begin{options}+--just-this-repo+\end{options}+This option limits the check or repair to the current repo and+omits any caches or other repos listed as a source of patches.++\begin{code}+just_this_repo =+    DarcsNoArgOption [] ["just-this-repo"] JustThisRepo+                        "Limit the check or repair to the current repo"+\end{code}++\begin{code}+check, repair, check_or_repair :: DarcsOption+\end{code}++\begin{options}+--check+\end{options}+This option specifies checking mode.++\begin{code}+check =+    DarcsNoArgOption [] ["check"] Check+                        "Specify checking mode"+\end{code}++\begin{options}+--repair+\end{options}+This option specifies repair mode.++\begin{code}+repair =+    DarcsNoArgOption [] ["repair"] Repair+                        "Specify repair mode"++check_or_repair = concat_options [check, repair]+ -- | @'patch_select_flag' f@ holds whenever @f@ is a way of selecting -- patches such as @PatchName n@. patch_select_flag :: DarcsFlag -> Bool@@ -1523,4 +1627,9 @@ patch_select_flag (AfterPattern _) = True patch_select_flag (UpToPattern _) = True patch_select_flag _ = False++-- | The integer corresponding to a string, if it's only composed of digits.+--   Otherwise, -1.+number_string :: String -> Int+number_string s = if and (map isDigit s) then read s else (-1) \end{code}
src/Darcs/Bug.hs view
@@ -2,40 +2,26 @@ module Darcs.Bug ( _bug, _bugDoc, _impossible, _fromJust                  ) where -import System.IO.Unsafe ( unsafePerformIO )-import Text.Regex ( matchRegex, mkRegex )--import Autoconf( darcs_version )-import Printer ( Doc, errorDoc, text, ($$), (<+>) )+import Printer ( Doc, errorDoc, text, ($$) )  type BugStuff = (String, Int, String, String)-type FetchUrl = String -> IO String -_bug :: FetchUrl -> BugStuff -> String -> a-_bug fetchUrl bs s = _bugDoc fetchUrl bs (text s)+_bug :: BugStuff -> String -> a+_bug bs s = _bugDoc bs (text s) -_bugDoc :: FetchUrl -> BugStuff -> Doc -> a-_bugDoc fetchUrl bs s =-    errorDoc $ text "bug in darcs!" $$ s <+> text ("at "++_bugLoc bs) $$-    unsafePerformIO ((mkms . lines) `fmap` (fetchUrl "http://darcs.net/maintenance"-                                            `catch` \_ -> return ""))-    where mkms [] = text "I'm unable to check http://darcs.net/maintenance to see if this version is supported."-                    $$ text "If it is supported, please report this to bugs@darcs.net"-                    $$ text "If possible include the output of 'darcs --exact-version'."-          mkms (a:b:r) = case matchRegex (mkRegex a) darcs_version of-                         Nothing -> mkms r-                         Just _ -> case reads b of-                                   [(m,"")] -> text m-                                   _ -> mkms r-          mkms [_] = mkms []+_bugDoc :: BugStuff -> Doc -> a+_bugDoc bs s = errorDoc $+   text ("bug at " ++ _bugLoc bs) $$ s $$+   text ("See http://wiki.darcs.net/index.html/BugTrackerHowto " +++         "for help on bug reporting.")  _bugLoc :: BugStuff -> String _bugLoc (file, line, date, time) = file++":"++show line++" compiled "++time++" "++date -_impossible :: FetchUrl -> BugStuff -> a-_impossible fetchUrl bs = _bug fetchUrl bs $ "Impossible case at "++_bugLoc bs+_impossible :: BugStuff -> a+_impossible bs = _bug bs $ "Impossible case at "++_bugLoc bs -_fromJust :: FetchUrl -> BugStuff -> Maybe a -> a-_fromJust fetchUrl bs mx =-  case mx of Nothing -> _bug fetchUrl bs $ "fromJust error at "++_bugLoc bs+_fromJust :: BugStuff -> Maybe a -> a+_fromJust bs mx =+  case mx of Nothing -> _bug bs $ "fromJust error at "++_bugLoc bs              Just x  -> x
src/Darcs/ColorPrinter.hs view
@@ -101,13 +101,14 @@ -- | @'fancyPrinters' h@ returns a set of printers suitable for outputting -- to @h@ fancyPrinters :: Printers-fancyPrinters h = Printers { colorP     = colorPrinter (getPolicy h),+fancyPrinters h = let policy = getPolicy h in +                      Printers { colorP = colorPrinter policy,                              invisibleP = invisiblePrinter,-                             hiddenP = colorPrinter (getPolicy h) Green,-                             userchunkP  = userchunkPrinter (getPolicy h),-                             defP       = escapePrinter (getPolicy h),-                             lineColorT = lineColorTrans (getPolicy h),-                             lineColorS = lineColorSuffix (getPolicy h)+                             hiddenP = colorPrinter policy Green,+                             userchunkP = userchunkPrinter policy,+                             defP       = escapePrinter policy,+                             lineColorT = lineColorTrans policy,+                             lineColorS = lineColorSuffix policy                            }  -- | @'lineColorTrans' policy@ tries to color a Doc, according to policy po.
src/Darcs/Commands.lhs view
@@ -169,10 +169,11 @@ command_alias :: String -> DarcsCommand -> DarcsCommand command_alias n c =   c { command_name = n-    , command_help = desc ++ "\n" ++ command_help c-    , command_description = desc+    , command_description = "Alias for `darcs " ++ command_name c ++ "'."+    , command_help = "The `darcs " ++ n ++ "' command is an alias for " +++                     "`darcs " ++ command_name c ++ "'.\n" +++                     command_help c     }- where desc = "Alias for " ++ command_name c  command_stub :: String -> String -> String -> DarcsCommand -> DarcsCommand command_stub n h d c =@@ -187,7 +188,10 @@            usage_helper cs ++ "\n" ++            "Use 'darcs COMMAND --help' for help on a single command.\n" ++            "Use 'darcs --version' to see the darcs version number.\n" ++-           "Use 'darcs --exact-version' to get the exact version of this darcs instance.\n\n" +++           "Use 'darcs --exact-version' to get the exact version of this darcs instance.\n" +++           "Use 'darcs help patterns' for help on patch matching.\n" +++           "Use 'darcs help environment' for help on environment variables.\n" +++           "\n" ++            "Check bug reports at http://bugs.darcs.net/\n"  subusage :: DarcsCommand -> String@@ -204,7 +208,7 @@ usage_helper (Hidden_command _:cs) = usage_helper cs usage_helper ((Command_data c):cs) = "  "++pad_spaces (command_name c) 15 ++                       chomp_newline (command_description c)++"\n"++usage_helper cs-usage_helper ((Group_name n):cs) = n ++ "\n" ++ usage_helper cs+usage_helper ((Group_name n):cs) = "\n" ++ n ++ "\n" ++ usage_helper cs  chomp_newline :: String -> String chomp_newline "" = ""
src/Darcs/Commands/Add.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs add}+\darcsCommand{add} \begin{code} module Darcs.Commands.Add ( add ) where @@ -42,22 +42,17 @@                       ) import Darcs.Patch.FileName ( fp2fn ) import Darcs.RepoPath ( toFilePath )-import Control.Monad ( when )+import Control.Monad ( when, unless ) import Darcs.Repository.Prefs ( darcsdir_filter, boring_file_filter ) import Data.Maybe ( maybeToList ) import System.FilePath.Posix ( takeDirectory, (</>) ) import System.IO ( hPutStrLn, stderr ) import qualified System.FilePath.Windows as WindowsFilePath+import Darcs.Gorsvet( invalidateIndex )  add_description :: String add_description = "Add one or more new files or directories."-\end{code} -\options{add}--\haskell{add_help}--\begin{code} add_help :: String add_help =  "Generally a repository contains both files that should be version\n" ++@@ -104,6 +99,9 @@ add_cmd opts args = withRepoLock opts $- \repository ->  do cur <- slurp_pending repository     origfiles <- map toFilePath `fmap` fixSubPaths opts args+    when (null origfiles) $+       putStrLn "Nothing specified, nothing added." >>+       putStrLn "Maybe you wanted to say `darcs add --recursive .'?"     parlist <- get_parents cur origfiles     flist' <- if Recursive `elem` opts               then expand_dirs origfiles@@ -111,16 +109,17 @@     let flist = nubsort (parlist ++ flist')     -- refuse to add boring files recursively:     nboring <- if Boring `elem` opts-               then return $ darcsdir_filter+               then return darcsdir_filter                else boring_file_filter     let putInfoLn = if Quiet `elem` opts then \_ -> return () else putStrLn-    sequence_ $ map (putInfoLn . ((msg_skipping msgs ++ " boring file ")++)) $-              flist \\ nboring flist+    mapM_ (putInfoLn . ((msg_skipping msgs ++ " boring file ")++)) $+      flist \\ nboring flist     date <- getIsoDateTime+    invalidateIndex repository     ps <- addp msgs opts date cur $ nboring flist-    when (nullFL ps && not (null args)) $ do+    when (nullFL ps && not (null args)) $         fail "No files were added"-    when (not gotDryRun) $ add_to_pending repository ps+    unless gotDryRun $ add_to_pending repository ps   where     gotDryRun = DryRun `elem` opts     msgs | gotDryRun = dryRunMessages@@ -141,7 +140,7 @@             if gotAllowCaseOnly then ":"                 else ";\nnote that to ensure portability we don't allow\n" ++                      "files that differ only in case. Use --case-ok to override this:"-    when (not (null dups)) $ do+    unless (null dups) $ do        dupMsg <-          case uniq_dups of          [f] ->@@ -172,8 +171,8 @@   addp' :: Slurpy -> FilePath -> IO (Slurpy, Maybe (FL Prim), Maybe FilePath)   addp' cur f =     if already_has-    then do return (cur, Nothing, Just f)-    else do+    then return (cur, Nothing, Just f)+    else     if is_badfilename        then do putInfo $ "The filename " ++ f ++ " is invalid under Windows.\nUse --reserved-ok to allow it."                return add_failure
src/Darcs/Commands/AmendRecord.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs amend-record}+\darcsCommand{amend-record} \begin{code} module Darcs.Commands.AmendRecord ( amendrecord ) where import Data.List ( sort )@@ -26,10 +26,10 @@ import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName,                                EditLongComment, PromptLongComment) ) import Darcs.Lock ( world_readable_temp )-import Darcs.RepoPath ( toFilePath )+import Darcs.RepoPath ( toFilePath, sp2fn ) import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info ) import Darcs.Repository ( withRepoLock, ($-), withGutsOf,-                    get_unrecorded, get_unrecorded_unsorted, slurp_recorded,+                    get_unrecorded_in_files, get_unrecorded_in_files_unsorted,                     tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,                     sync_repo, amInRepository,                   )@@ -58,16 +58,12 @@                       ) import Darcs.Utils ( askUser ) import Printer ( putDocLn )+import Darcs.Gorsvet( invalidateIndex )  amendrecord_description :: String amendrecord_description =- "Replace a patch with a better version before it leaves your repository."-\end{code}--\options{amend-record}+ "Improve a patch before it leaves your repository." -\haskell{amend-record_help}-\begin{code} amendrecord_help :: String amendrecord_help =  "Amend-record updates a `draft' patch with additions or improvements,\n" ++@@ -88,7 +84,8 @@  "\n" ++  "When recording a draft patch, it is a good idea to start the name with\n" ++  "`DRAFT:' so that other developers know it is not finished.  When\n" ++- "finished, remove it with `darcs amend-record --edit-description'.\n" +++ "finished, remove it with `darcs amend-record --edit-long-comment'.\n" +++ "To change the patch name without starting an editor, use --patch-name.\n" ++  "\n" ++  "Like `darcs record', if you call amend-record with files as arguments,\n" ++  "you will only be asked about changes to those files.  So to amend a\n" ++@@ -98,8 +95,9 @@  "\n" ++  "It is usually a bad idea to amend another developer's patch.  To make\n" ++  "amend-record only ask about your own patches by default, you can add\n" ++- "something like `amend-record match David Roundy' to ~/.darcs/defaults,\n" ++- "where `David Roundy' is your name.\n"+ "something like `amend-record match David Roundy' to ~/.darcs/defaults, \n" +++ "where `David Roundy' is your name. " ++ + "On Windows use C:/Documents And Settings/user/Application Data/darcs/defaults\n"  amendrecord :: DarcsCommand amendrecord = DarcsCommand {command_name = "amend-record",@@ -130,15 +128,14 @@          putStrLn $ "Amending changes in "++unwords (map show files)++":\n"     with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do         ch <- if All `elem` opts -              then get_unrecorded_unsorted repository-              else get_unrecorded repository+              then get_unrecorded_in_files_unsorted repository (map sp2fn files)+              else get_unrecorded_in_files repository (map sp2fn files)         case ch of           NilFL | not edit_metadata -> putStrLn "No changes!"           _ -> do               date <- get_date opts-              s <- slurp_recorded repository               with_selected_changes_to_files' "add" (filter (==All) opts)-                s (map toFilePath files) ch $ \ (chs:>_) ->+                (map toFilePath files) ch $ \ (chs:>_) ->                   if (nullFL chs && not edit_metadata)                   then putStrLn "You don't want to record anything!"                   else do@@ -165,6 +162,7 @@                                                                  new_author new_log                        let newp = fixp oldp chs new_pinf                        defineChanges newp+                       invalidateIndex repository                        withGutsOf repository $ do                          tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL)                          tentativelyAddPatch repository opts newp
src/Darcs/Commands/Annotate.lhs view
@@ -15,8 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs annotate}-\label{annotate}+\darcsCommand{annotate} \begin{code} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -cpp #-}@@ -61,18 +60,10 @@ import Printer ( putDocLn, text, errorDoc, ($$), prefix, (<+>),                  Doc, empty, vcat, (<>), renderString, packedString ) #include "impossible.h"-\end{code} -\options{annotate}--\haskell{annotate_description}-\begin{code} annotate_description :: String annotate_description = "Display which patch last modified something."-\end{code}-\haskell{annotate_help} -\begin{code} annotate_help :: String annotate_help =  "Annotate displays which patches created or last modified a directory\n"++@@ -129,11 +120,9 @@                   c <- slurp "."                   contextualPrintPatch c p           else printPatch p-    where showpi = if MachineReadable `elem` opts-                   then showPatchInfo-                   else if XMLOutput `elem` opts-                        then to_xml-                        else human_friendly+    where showpi | MachineReadable `elem` opts = showPatchInfo+                 | XMLOutput `elem` opts       = to_xml+                 | otherwise                   = human_friendly           show_summary :: RepoPatch p => Named p C(x y) -> Doc           show_summary = if XMLOutput `elem` opts                          then xml_summary@@ -304,7 +293,7 @@           else putAnn $ text $ "File "++toFilePath f   mk <- getMarkedupFile repository ci createdname   old_pis <- (dropWhile (/= pinfo).mapRL info.concatRL) `fmap` read_repo repository-  sequence_ $ map (annotate_markedup opts pinfo old_pis) mk+  mapM_ (annotate_markedup opts pinfo old_pis) mk   when (XMLOutput `elem` opts) $  putDocLn $ p2xml_close pinfo (PopFile inf)   where ci = fromJust $ createdByI inf         createdname = BC.unpack $ fromJust $ creationNameI inf@@ -317,20 +306,16 @@  text_markedup :: PatchInfo -> [PatchInfo] -> (BC.ByteString, LineMark) -> IO () text_markedup _ _ (l,None) = putLine ' ' l-text_markedup pinfo old_pis (l,RemovedLine wheni) =-    if wheni == pinfo-    then putLine '-' l-    else if wheni `elem` old_pis-         then return ()-         else putLine ' ' l-text_markedup pinfo old_pis (l,AddedLine wheni) =-    if wheni == pinfo-    then putLine '+' l-    else if wheni `elem` old_pis-         then do putAnn $ text "Following line added by "-                       <> showPatchInfo wheni-                 putLine ' ' l-         else return ()+text_markedup pinfo old_pis (l,RemovedLine wheni)+    | wheni == pinfo       = putLine '-' l+    | wheni `elem` old_pis = return ()+    | otherwise            = putLine ' ' l+text_markedup pinfo old_pis (l,AddedLine wheni)+    | wheni == pinfo       = putLine '+' l+    | wheni `elem` old_pis = do putAnn $ text "Following line added by "+                                      <> showPatchInfo wheni+                                putLine ' ' l+    | otherwise            = return () text_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)     | whenadd == pinfo = do putAnn $ text "Following line removed by "                                   <> showPatchInfo whenrem@@ -351,32 +336,28 @@  xml_markedup :: PatchInfo -> [PatchInfo] -> (BC.ByteString, LineMark) -> IO () xml_markedup _ _ (l,None) = putLine ' ' l-xml_markedup pinfo old_pis (l,RemovedLine wheni) =-    if wheni == pinfo-    then putDocLn $ text "<removed_line>"-                 $$ escapeXML (BC.unpack l)-                 $$ text "</removed_line>"-    else if wheni `elem` old_pis-         then return ()-         else putDocLn $ text "<normal_line>"-                      $$ text "<removed_by>"-                      $$ to_xml wheni-                      $$ text "</removed_by>"-                      $$ escapeXML (BC.unpack l)-                      $$ text "</normal_line>"-xml_markedup pinfo old_pis (l,AddedLine wheni) =-    if wheni == pinfo-    then putDocLn $ text "<added_line>"-                 $$ escapeXML (BC.unpack l)-                 $$ text "</added_line>"-    else if wheni `elem` old_pis-         then putDocLn $ text "<normal_line>"-                      $$ text "<added_by>"-                      $$ to_xml wheni-                      $$ text "</added_by>"-                      $$ escapeXML (BC.unpack l)-                      $$ text "</normal_line>"-         else return ()+xml_markedup pinfo old_pis (l,RemovedLine wheni)+    | wheni == pinfo       = putDocLn $ text "<removed_line>"+                             $$ escapeXML (BC.unpack l)+                             $$ text "</removed_line>"+    | wheni `elem` old_pis = return ()+    | otherwise            = putDocLn $ text "<normal_line>"+                             $$ text "<removed_by>"+                             $$ to_xml wheni+                             $$ text "</removed_by>"+                             $$ escapeXML (BC.unpack l)+                             $$ text "</normal_line>"+xml_markedup pinfo old_pis (l,AddedLine wheni)+    | wheni == pinfo       = putDocLn $ text "<added_line>"+                             $$ escapeXML (BC.unpack l)+                             $$ text "</added_line>"+    | wheni `elem` old_pis = putDocLn $ text "<normal_line>"+                             $$ text "<added_by>"+                             $$ to_xml wheni+                             $$ text "</added_by>"+                             $$ escapeXML (BC.unpack l)+                             $$ text "</normal_line>"+    | otherwise            = return () xml_markedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)     | whenadd == pinfo =         putDocLn $ text "<added_line>"
src/Darcs/Commands/Apply.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs apply}+\darcsCommand{apply} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -43,12 +43,12 @@                         all_interactive, sendmail_cmd,                         leave_test_dir, happy_forwarding,                          dry_run, print_dry_run_message_and_exit,-                        set_scripts_executable+                        set_scripts_executable, restrict_paths                       ) import qualified Darcs.Arguments as DarcsArguments ( cc ) import Darcs.RepoPath ( toFilePath, useAbsoluteOrStd ) import Darcs.Repository ( SealedPatchSet, withRepoLock, ($-), amInRepository,-                          tentativelyMergePatches, slurp_recorded,+                          tentativelyMergePatches,                     sync_repo, read_repo,                     finalizeRepositoryChanges,                     applyToWorking,@@ -72,17 +72,12 @@ import Darcs.Patch.Bundle ( scan_bundle ) import Darcs.Sealed ( Sealed(Sealed) ) import Printer ( packedString, putDocLn, vcat, text, ($$), errorDoc, empty )+import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h"  apply_description :: String-apply_description =- "Apply patches (from an email bundle) to the repository."-\end{code}--\options{apply}+apply_description = "Apply a patch bundle created by `darcs send'." -\haskell{apply_help}-\begin{code} apply_help :: String apply_help =  "Apply is used to apply a bundle of patches to this repository.\n"++@@ -105,7 +100,8 @@                                                   happy_forwarding,                                                   sendmail_cmd,                                                   ignoretimes, nocompress,-                                                  set_scripts_executable, umask_option],+                                                  set_scripts_executable, umask_option,+                                                  restrict_paths],                       command_basic_options = [verify,                                               all_interactive]++dry_run++                                               [apply_conflict_options,@@ -139,11 +135,10 @@        do putStr $ "All these patches have already been applied.  " ++                      "Nothing to do.\n"           exitWith ExitSuccess-  s <- slurp_recorded repository   let their_ps = mapFL_FL (n2pia . conscientiously (text ("We cannot apply this patch "                                                           ++"bundle, since we're missing:") $$))                  $ reverseRL $ head $ unsafeUnRL them'-  with_selected_changes "apply" fixed_opts s their_ps $+  with_selected_changes "apply" fixed_opts their_ps $                             \ (to_be_applied:>_) -> do    print_dry_run_message_and_exit "apply" opts to_be_applied    when (nullFL to_be_applied) $@@ -158,6 +153,7 @@     definePatches to_be_applied     Sealed pw <- tentativelyMergePatches repository "apply" opts                  (reverseRL $ head $ unsafeUnRL us') to_be_applied+    invalidateIndex repository     withSignalsBlocked $ do finalizeRepositoryChanges repository                             wait_a_moment -- so work will be more recent than rec                             applyToWorking repository opts pw `catch` \e ->
src/Darcs/Commands/Changes.lhs view
@@ -15,14 +15,14 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs changes}+\darcsCommand{changes} \begin{code} {-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, PatternGuards #-}  module Darcs.Commands.Changes ( changes ) where -import Data.List ( sort )+import Data.List ( intersect, sort ) import Data.Maybe ( fromMaybe ) import Control.Monad ( when, unless ) @@ -38,14 +38,16 @@                          working_repo_dir, only_to_files,                          summary, changes_reverse,                          match_several_or_range,+                         match_maxcount, maxCount,                          all_interactive, showFriendly,                          network_options                       ) import Darcs.RepoPath ( toFilePath, rootDirectory ) import Darcs.Patch.FileName ( fp2fn, fn2fp, norm_path )-import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd, get_unrecorded_unsorted,+import Darcs.Repository ( Repository, PatchSet, PatchInfoAnd,+                          get_unrecorded_in_files_unsorted,                           withRepositoryDirectory, ($-), findRepository,-                          read_repo, slurp_recorded )+                          read_repo ) import Darcs.Patch.Info ( to_xml, showPatchInfo ) import Darcs.Patch.Depends ( get_common_and_uncommon ) import Darcs.Patch.TouchesFiles ( look_touch )@@ -58,24 +60,18 @@                match_first_patchset, match_second_patchset,              ) import Darcs.Commands.Annotate ( created_as_xml )-import ByteStringUtils ( linesPS )-import Printer ( Doc, putDocLnWith, simplePrinters, renderPS, (<+>),-                 renderString, prefix,-                 packedString, text, vcat, vsep, ($$), empty, errorDoc )+import Printer ( Doc, putDocLnWith, simplePrinters, (<+>),+                 renderString, prefix, text, vcat, vsep, +                 ($$), empty, errorDoc, insert_before_lastline ) import Darcs.ColorPrinter ( fancyPrinters ) import Progress ( setProgressMode, debugMessage ) import Darcs.SelectChanges ( view_changes ) import Darcs.Sealed ( unsafeUnseal ) #include "impossible.h"-\end{code} -\options{changes}-\begin{code} changes_description :: String changes_description = "Gives a changelog-style summary of the repository history."-\end{code}-\haskell{changes_help}-\begin{code}+ changes_help :: String changes_help =  "Changes gives a changelog-style summary of the repository history,\n"++@@ -93,6 +89,7 @@                         command_argdefaults = nodefaults,                         command_advanced_options = network_options,                         command_basic_options = [match_several_or_range,+                                                 match_maxcount,                                                  only_to_files,                                                  changes_format,                                                  summary,@@ -113,7 +110,8 @@   withRepositoryDirectory opts repodir $- \repository -> do   unless (Debug `elem` opts) $ setProgressMode False   files <- sort `fmap` fixSubPaths opts args-  unrec <- get_unrecorded_unsorted repository+  unrec <- if null files then return identity+             else get_unrecorded_in_files_unsorted repository (map (fp2fn . toFilePath) files)            `catch` \_ -> return identity -- this is triggered when repository is remote   let filez = map (fn2fp . norm_path . fp2fn) $ apply_to_filepaths (invert unrec) $ map toFilePath files       filtered_changes p = maybe_reverse $ get_changes_info opts filez p@@ -121,14 +119,15 @@   patches <- read_repo repository   debugMessage "Done reading the repository."   if Interactive `elem` opts-    then do let (fp,_,_) = filtered_changes patches-            s <- slurp_recorded repository-            view_changes opts s filez (unsafeFL fp)+    then do let (fp_and_fs, _, _) = filtered_changes patches+                fp = map fst fp_and_fs+            view_changes opts (unsafeFL fp)     else do when (not (null files) && not (XMLOutput `elem` opts)) $                  putStrLn $ "Changes to "++unwords filez++":\n"             debugMessage "About to print the changes..."             let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters-            ps <- read_repo repository+            ps <- read_repo repository -- read repo again to prevent holding onto+                                       -- values forced by filtered_changes             putDocLnWith printers $ changelog opts ps $ filtered_changes patches   where maybe_reverse (xs,b,c) = if Reverse `elem` opts                                  then (reverse xs, b, c)@@ -151,13 +150,19 @@ Without any options to limit the scope of the changes, history will be displayed going back as far as possible. +\begin{options}+--max-count+\end{options} +If changes is given a \verb!--max-count! option, it only outputs up to as that+number of changes.+ \begin{code} get_changes_info :: RepoPatch p => [DarcsFlag] -> [FilePath] -> PatchSet p-                 -> ([PatchInfoAnd p], [FilePath], Doc)+                 -> ([(PatchInfoAnd p, [FilePath])], [FilePath], Doc) get_changes_info opts plain_fs ps =   case get_common_and_uncommon (p2s,p1s) of-  (_,us:\/:_) -> filter_patches_by_names fs $ filter pf $ unsafeUnRL $ concatRL us+  (_,us:\/:_) -> filter_patches_by_names (maxCount opts) fs $ filter pf $ unsafeUnRL $ concatRL us   where fs = map (\x -> "./" ++ x) $ plain_fs         p1s = if first_match opts then unsafeUnseal $ match_first_patchset opts ps                                   else NilRL:<:NilRL@@ -167,27 +172,45 @@              then match_a_patchread opts              else \_ -> True -filter_patches_by_names :: RepoPatch p => [FilePath]-                        -> [PatchInfoAnd p]-                        -> ([PatchInfoAnd p],[FilePath], Doc)-filter_patches_by_names _ [] = ([], [], empty)-filter_patches_by_names [] pps = (pps, [], empty)-filter_patches_by_names fs (hp:ps)+-- | Take a list of filenames and patches and produce a list of+-- patches that actually touch the given files with list of touched+-- file names, a new file list that represents the same set of files+-- as in input, before the returned patches would have been applied,+-- and possibly an error. Additionaly, the function takes a "depth+-- limit" -- maxcount, that could be Nothing (return everything) or+-- "Just n" -- returns at most n patches touching the file (starting+-- from the beginning of the patch list).+filter_patches_by_names :: RepoPatch p =>+                           Maybe Int -- ^ maxcount+                        -> [FilePath] -- ^ filenames+                        -> [PatchInfoAnd p] -- ^ patchlist+                        -> ([(PatchInfoAnd p,[FilePath])], [FilePath], Doc)+filter_patches_by_names (Just 0) _ _ = ([], [], empty)+filter_patches_by_names _ _ [] = ([], [], empty)+filter_patches_by_names maxcount [] (hp:ps) =+    (hp, []) -:- filter_patches_by_names (subtract 1 `fmap` maxcount) [] ps+filter_patches_by_names maxcount fs (hp:ps)     | Just p <- hopefullyM hp =     case look_touch fs (invert p) of-    (True, []) -> ([hp], fs, empty)-    (True, fs') -> hp -:- filter_patches_by_names fs' ps-    (False, fs') -> filter_patches_by_names fs' ps-filter_patches_by_names _ (hp:_) =+    (True, []) -> ([(hp, fs)], fs, empty)+    (True, fs') -> (hp, fs) -:- filter_patches_by_names+                                (subtract 1 `fmap` maxcount) fs' ps+    (False, fs') -> filter_patches_by_names maxcount fs' ps+filter_patches_by_names _ _ (hp:_) =     ([], [], text "Can't find changes prior to:" $$ description hp) +-- | Note, lazy pattern matching is required to make functions like+-- filter_patches_by_names lazy in case you are only not interested in+-- the first element. E.g.:+--+--   let (fs, _, _) = filter_patches_by_names ... (-:-) :: a -> ([a],b,c) -> ([a],b,c)-x -:- (xs,y,z) = (x:xs,y,z)+x -:- ~(xs,y,z) = (x:xs,y,z) -changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p -> ([PatchInfoAnd p], [FilePath], Doc)+changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p -> ([(PatchInfoAnd p, [FilePath])], [FilePath], Doc)           -> Doc-changelog opts patchset (pis, fs, errstring)-    | Count `elem` opts = text $ show $ length pis+changelog opts patchset (pis_and_fs, orig_fs, errstring)+    | Count `elem` opts = text $ show $ length pis_and_fs     | MachineReadable `elem` opts =         if renderString errstring == ""         then vsep $ map (showPatchInfo.info) pis@@ -198,20 +221,20 @@       $$ vcat actual_xml_changes       $$ text "</changelog>"     | Summary `elem` opts || Verbose `elem`  opts =-           vsep (map (number_patch change_with_summary) pis)+           vsep (map (number_patch change_with_summary) pis_and_fs)         $$ errstring-    | otherwise = vsep (map (number_patch description) pis)+    | otherwise = vsep (map (number_patch description') pis_and_fs)                $$ errstring-    where change_with_summary hp+    where change_with_summary (hp, fs)               | Just p <- hopefullyM hp = if OnlyChangesToFiles `elem` opts-                                          then description hp $$-                                               showFriendly opts (filterFL xx $ effect p)+                                          then description hp $$ text "" $$+                                               indent (showFriendly opts (filterFL xx $ effect p))                                           else showFriendly opts p               | otherwise = description hp                             $$ indent (text "[this patch is unavailable]")               where xx x = case list_touched_files x of-                             [z] | z `elem` fs -> NotEq-                             _ -> IsEq+                             ys | null $ ys `intersect` fs -> IsEq+                             _ -> NotEq           xml_with_summary hp               | Just p <- hopefullyM hp = insert_before_lastline                                            (to_xml $ info hp) (indent $ xml_summary p)@@ -220,12 +243,12 @@           actual_xml_changes = if Summary `elem` opts                                then map xml_with_summary pis                                else map (to_xml.info) pis-          xml_file_names = map (created_as_xml first_change) fs+          xml_file_names = map (created_as_xml first_change) orig_fs           first_change = if Reverse `elem` opts                          then info $ head pis                          else info $ last pis           number_patch f x = if NumberPatches `elem` opts-                             then case get_number x of+                             then case get_number (fst x) of                                   Just n -> text (show n++":") <+> f x                                   Nothing -> f x                              else f x@@ -235,12 +258,9 @@                     gn n (b:<:bs) | seq n (info b) == iy = Just n                                   | otherwise = gn (n+1) bs                     gn _ NilRL = Nothing+          pis = map fst pis_and_fs+          description' = description . fst -insert_before_lastline :: Doc -> Doc -> Doc-insert_before_lastline a b =-    case reverse $ map packedString $ linesPS $ renderPS a of-    (ll:ls) -> vcat (reverse ls) $$ b $$ ll-    [] -> impossible \end{code}  \begin{options}
src/Darcs/Commands/Check.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs check}+\darcsCommand{check} \begin{code} module Darcs.Commands.Check ( check ) where import Control.Monad ( when )@@ -35,12 +35,7 @@ import Darcs.Diff ( unsafeDiff ) import Darcs.Repository.Prefs ( filetype_function ) import Printer ( putDocLn, text, ($$), (<+>) )-\end{code} -\options{check}--\haskell{check_description}-\begin{code} check_description :: String check_description = "Check the repository for consistency."
src/Darcs/Commands/Convert.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs convert}+\darcsCommand{convert} \begin{code} {-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}@@ -67,33 +67,55 @@ import Workaround ( setExecutable ) import qualified Data.ByteString as B (isPrefixOf, readFile) import qualified Data.ByteString.Char8 as BC (pack)+import Darcs.Gorsvet( invalidateIndex )  convert_description :: String-convert_description =- "Convert a repository to darcs-2 format."-\end{code}--\options{convert}--You may specify the name of the repository created by providing a second-argument to convert, which is a directory name.+convert_description = "Convert a repository from a legacy format." -\begin{code} convert_help :: String convert_help =- "Convert is used to convert a repository to darcs-2 format.\n\n" ++- "The recommended way to convert an existing project from darcs 1 to\n" ++- "darcs 2 is to merge all branches, `darcs convert' the resulting\n" ++- "repository, re-create each branch by using `darcs get' on the\n" ++- "converted repository, then using `darcs obliterate' to delete patches\n" ++- "of branches.\n"+ "The current repository format is called `darcs-2'.  It was introduced\n" +++ "in Darcs 2.0 and became the default for new projects in Darcs 2.2.\n" +++ "The `darcs convert' command allows existing projects to migrate to\n" +++ "this format from the older `darcs-1' format.\n" +++ "\n" +++ "This command DOES NOT modify the source repository; a new destination\n" +++ "repository is created.  It is safe to run this command more than once\n" +++ "on a repository (e.g. for testing), before the final conversion.\n" +++ "\n" +++ convert_help' +++ "\n" +++ "Due to this limitation, migrating a multi-branch project is a little\n" +++ "awkward.  Sorry!  Here is the recommended process:\n" +++ "\n" +++ " 1. for each branch `foo', tag that branch with `foo-final';\n" +++ " 2. merge all branches together (--allow-conflicts may help);\n" +++ " 3. run `darcs optimize --reorder' on the result;\n" +++ " 4. run `darcs convert' to create a merged darcs-2 repository;\n" +++ " 5. re-create each branch by calling `darcs get --tag foo-final' on\n" +++ "    the darcs-2 repository; and finally\n" +++ " 6. use `darcs obliterate' to delete the foo-final tags.\n" +-- | This part of the help is split out because it is used twice: in+-- the help string, and in the prompt for confirmation.+convert_help' :: String+convert_help' =+ "WARNING: the repository produced by this command is not understood by\n" +++ "Darcs 1.x, and patches cannot be exchanged between repositories in\n" +++ "darcs-1 and darcs-2 formats.\n" +++ "\n" +++ "Furthermore, darcs 2 repositories created by different invocations of\n" +++ "this command SHOULD NOT exchange patches, unless those repositories\n" +++ "had no patches in common when they were converted.  (That is, within a\n" +++ "set of repos that exchange patches, no patch should be converted more\n" +++ "than once.)\n"+ convert :: DarcsCommand convert = DarcsCommand {command_name = "convert",                     command_help = convert_help,                     command_description = convert_description,                     command_extra_args = -1,-                    command_extra_arg_help = ["<REPOSITORY>", "[<DIRECTORY>]"],+                    command_extra_arg_help = ["<SOURCE>", "[<DESTINATION>]"],                     command_command = convert_cmd,                     command_prereq = \_ -> return $ Right (),                     command_get_arg_possibilities = return [],@@ -104,19 +126,9 @@ convert_cmd :: [DarcsFlag] -> [String] -> IO () convert_cmd opts [inrepodir, outname] = convert_cmd (NewRepo outname:opts) [inrepodir] convert_cmd orig_opts [inrepodir] = do-  putDocLn $ text "WARNING: the repository produced by this command is not understood by" $$-             text "the darcs 1 program, and patches cannot be exchanged between" $$-             text "repositories in darcs 1 and darcs 2 formats.\n" $$-             text "Furthermore, darcs 2 repositories created by different invocations of" $$-             text "this command SHOULD NOT exchange patches, unless those repositories" $$-             text "had no patches in common when they were converted.  (That is, within a" $$-             text "set of repos that exchange patches, no patch should be converted more" $$-             text "than once.)\n" $$-             text "This command DOES NOT modify the source repository.  It is safe to run" $$-             text "this command more than once on a single repository, but the resulting" $$-             text "repositories will not be able to exchange patches.\n" $$-             text "Please confirm that you have read and understood the above"+  putStrLn convert_help'   let vow = "I understand the consequences of my action"+  putStrLn "Please confirm that you have read and understood the above"   vow' <- askUser ("by typing `" ++ vow ++ "': ")   when (vow' /= vow) $ fail "User didn't understand the consequences."   let opts = UseFormat2:orig_opts@@ -185,6 +197,7 @@                             finalizeRepositoryChanges repository -- this is to clean out pristine.hashed                             revertRepositoryChanges repository       sequence_ $ mapFL applySome $ bunchFL 100 $ progressFL "Converting patch" patches+      invalidateIndex repository       revertable $ createPristineDirectoryTree repository "."       when (SetScriptsExecutable `elem` opts) $                do putVerbose $ text "Making scripts executable"
src/Darcs/Commands/Diff.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs diff}+\darcsCommand{diff} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -29,7 +29,7 @@ import Control.Monad ( when ) import Data.List ( (\\) ) -import Autoconf ( diff_program )+import Darcs.External( diff_program ) import CommandLine ( parseCmd ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag(DiffFlags, Unified, DiffCmd,@@ -56,15 +56,10 @@ import Darcs.Sealed ( unsafeUnseal ) import Printer ( Doc, putDoc, vcat, empty, ($$) ) #include "impossible.h"-\end{code} -\options{diff}-\begin{code} diff_description :: String diff_description = "Create a diff between two versions of the repository."-\end{code}-\haskell{diff_help}-\begin{code}+ diff_help :: String diff_help =  "Diff can be used to create a diff between two versions which are in your\n"++@@ -130,16 +125,16 @@ -- This will either be whatever the user specified via --diff-command  or the -- default 'diff_program'.  Note that this potentially involves parsing the -- user's diff-command, hence the possibility for failure with an exception.-get_diff_cmd_and_args :: [DarcsFlag] -> String -> String+get_diff_cmd_and_args :: String -> [DarcsFlag] -> String -> String                       -> Either String (String, [String])-get_diff_cmd_and_args opts f1 f2 = helper opts where+get_diff_cmd_and_args cmd opts f1 f2 = helper opts where   helper (DiffCmd c:_) =     case parseCmd [ ('1', f1) , ('2', f2) ] c of     Left err        -> Left $ show err     Right ([],_)    -> bug $ "parseCmd should never return empty list"     Right ((h:t),_) -> Right (h,t)   helper [] = -- if no command specified, use 'diff'-    Right (diff_program, ("-rN":get_diff_opts opts++[f1,f2]))+    Right (cmd, ("-rN":get_diff_opts opts++[f1,f2]))   helper (_:t) = helper t \end{code} @@ -220,10 +215,11 @@     putDoc $ changelog (get_diff_info opts morepatches)             $$ thediff     where rundiff :: String -> String -> IO Doc-          rundiff f1 f2 =-            case get_diff_cmd_and_args opts f1 f2 of-            Left err -> fail err-            Right (d_cmd, d_args) ->+          rundiff f1 f2 = do+            cmd <- diff_program+            case get_diff_cmd_and_args cmd opts f1 f2 of+             Left err -> fail err+             Right (d_cmd, d_args) ->               let other_diff = has_diff_cmd_flag opts in               do when other_diff $ putStrLn $                    "Running command '" ++ unwords (d_cmd:d_args) ++ "'"
src/Darcs/Commands/Dist.lhs view
@@ -15,12 +15,12 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs dist}+\darcsCommand{dist} \begin{code} module Darcs.Commands.Dist ( dist ) where import System.Directory ( setCurrentDirectory ) import Workaround ( getCurrentDirectory )-import System.Exit ( ExitCode(..) )+import System.Exit ( ExitCode(..), exitWith ) import System.Cmd ( system ) import System.FilePath.Posix ( takeFileName, (</>) ) import Data.Char ( isAlphaNum )@@ -41,15 +41,10 @@                           createPartialsPristineDirectoryTree ) import Darcs.Repository.Prefs ( get_prefval ) import Darcs.Lock ( withTemp, withTempDir, readBinFile )-import Darcs.RepoPath ( toFilePath )+import Darcs.RepoPath ( AbsolutePath, toFilePath ) import Darcs.Utils ( withCurrentDirectory ) import Exec ( exec, Redirect(..) ) -\end{code}-\options{dist}-\haskell{dist_help}-\begin{code}- dist_description :: String dist_description = "Create a distribution tarball." @@ -57,14 +52,12 @@ dist_help =  "The `darcs dist' command creates a compressed archive (a `tarball') in\n" ++  "the repository's root directory, containing the recorded state of the\n" ++- -- FIXME: _ is escaped to appease TeX while we wait for reST.- "working tree (unrecorded changes and the \\_darcs directory are\n" +++ "working tree (unrecorded changes and the _darcs directory are\n" ++  "excluded).\n" ++  "\n" ++  "If a predist command is set (see `darcs setpref'), that command will\n" ++  "be run on the tarball contents prior to archiving.  For example,\n" ++- -- FIXME: &s are escaped to appease TeX while we wait for reST.- "autotools projects would set it to `autoconf \\&\\& automake'.\n" +++ "autotools projects would set it to `autoconf && automake'.\n" ++  "\n" ++  "By default, the tarball (and the top-level directory within the\n" ++  "tarball) has the same name as the repository, but this can be\n" ++@@ -120,19 +113,30 @@         if have_nonrange_match opts           then withCurrentDirectory ddir $ get_nonrange_match repository opts           else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)-        case predist of Nothing -> return ExitSuccess-                        Just pd -> system pd-        setCurrentDirectory (toFilePath tempdir)-        exec "tar" ["-cf", "-", safename $ takeFileName $ toFilePath ddir]-                   (Null, File tarfile, AsIs)-        when verb $ withTemp $ \tar_listing -> do-                      exec "tar" ["-tf", "-"]-                           (File tarfile, File tar_listing, Stdout)-                      to <- readBinFile tar_listing-                      putStr to-        exec "gzip" ["-c"]-             (File tarfile, File resultfile, AsIs)-        putStrLn $ "Created dist as "++resultfile+        ec <- case predist of Nothing -> return ExitSuccess+                              Just pd -> system pd+        if (ec == ExitSuccess) then do_dist verb tarfile tempdir ddir resultfile+            else+                do+                putStrLn "Dist aborted due to predist failure"+                exitWith ec++-- | This function performs the actual distribution action itself.+-- NB - it does /not/ perform the pre-dist, that should already+-- have completed successfully before this is invoked.+do_dist :: Bool -> FilePath -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()+do_dist verb tarfile tempdir ddir resultfile = do+  setCurrentDirectory (toFilePath tempdir)+  exec "tar" ["-cf", "-", safename $ takeFileName $ toFilePath ddir]+             (Null, File tarfile, AsIs)+  when verb $ withTemp $ \tar_listing -> do+                exec "tar" ["-tf", "-"]+                     (File tarfile, File tar_listing, Stdout)+                to <- readBinFile tar_listing+                putStr to+  exec "gzip" ["-c"]+       (File tarfile, File resultfile, AsIs)+  putStrLn $ "Created dist as "++resultfile   where     safename n@(c:_) | isAlphaNum c  = n     safename n = "./" ++ n
+ src/Darcs/Commands/GZCRCs.lhs view
@@ -0,0 +1,189 @@+%  Copyright (C) 2009 Ganesh Sittampalam+%+%  This program is free software; you can redistribute it and/or modify+%  it under the terms of the GNU General Public License as published by+%  the Free Software Foundation; either version 2, or (at your option)+%  any later version.+%+%  This program is distributed in the hope that it will be useful,+%  but WITHOUT ANY WARRANTY; without even the implied warranty of+%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+%  GNU General Public License for more details.+%+%  You should have received a copy of the GNU General Public License+%  along with this program; see the file COPYING.  If not, write to+%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+%  Boston, MA 02110-1301, USA.++\subsection{darcs gzcrcs}+\darcsCommand{gzcrcs}+\begin{code}+{-# LANGUAGE CPP #-}+module Darcs.Commands.GZCRCs ( gzcrcs, doCRCWarnings ) where++import Control.Arrow ( (***) )+import Control.Monad ( when, unless )+import Control.Monad.Trans ( liftIO )+import Control.Monad.Writer ( runWriterT, tell )+import Data.List ( intersperse )+import Data.Monoid ( Any(..), Sum(..) )++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++import System.Directory ( getDirectoryContents, doesFileExist, doesDirectoryExist )+import System.Exit ( ExitCode(..), exitWith )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag( Quiet, Verbose, Check, Repair, JustThisRepo ),+                        check_or_repair, working_repo_dir, just_this_repo+                      )+import Darcs.Repository ( Repository, amInRepository, withRepository )+import Darcs.Patch ( RepoPatch )+import Printer ( putDocLn, text )+import ByteStringUtils ( isGZFile )+import Darcs.Lock ( gzWriteAtomicFilePSs )++-- This command needs access beyond the normal repository APIs (to+-- get at the caches and inspect them directly)+-- Could move the relevant code into Darcs.Repository modules+-- but it doesn't really seem worth it.+import Darcs.Repository.InternalTypes ( extractCache )+import Darcs.Repository.Cache ( Cache(..), writable, isthisrepo, hashedFilePath, allHashedDirs )+++#ifdef HAVE_HASKELL_ZLIB+import Darcs.Global ( getCRCWarnings, resetCRCWarnings )+import ByteStringUtils ( gzDecompress )+#else+-- These functions aren't available unless we have the Haskell zlib.+-- The gzcrcs command shouldn't be enabled in this case, but we would+-- still like to typecheck this module as much as possible so we include+-- dummy versions +noChecking :: String -> a+noChecking what = error $ "Darcs.Commands.GZCRCs." ++ what ++ ": gz CRC checking is not possible unless " +++                          "darcs has been built with the Haskell zlib. This code should be unreachable."+getCRCWarnings :: IO [FilePath]+getCRCWarnings = noChecking "getCRCWarnings"+resetCRCWarnings :: IO ()+resetCRCWarnings = noChecking "resetCRCWarnings"+gzDecompress :: Maybe Int -> BL.ByteString -> ([B.ByteString], Bool)+gzDecompress = noChecking "gzDecompress"+#endif++gzcrcs_description :: String+gzcrcs_description = "Check or repair the CRCs of compressed files in the repository."++gzcrcs_help :: String+gzcrcs_help = formatText+  [+   "Versions of darcs >=1.0.4 and <2.2.0 had a bug that caused compressed files " +++   "with bad CRCs (but valid data) to be written out. CRCs were not checked on " +++   "reading, so this bug wasn't noticed.",+   "This command inspects your repository for this corruption and optionally repairs it.",+   "By default it also does this for any caches you have configured and any other " +++   "local repositories listed as sources of patches for this one, perhaps because of a " +++   "lazy get. You can limit the scope to just the current repo with the --just-this-repo " +++   "flag.",+   "Note that readonly caches, or other repositories listed as sources, " +++   "will be checked but not repaired. Also, this command will abort if it encounters " +++   "any non-CRC corruption in compressed files.",+   "You may wish to also run 'darcs check --complete' before repairing the corruption. " +++   "This is not done automatically because it might result in needing to fetch extra " +++   "patches if the repository is lazy.",+   "If there are any other problems with your repository, you can still repair the CRCs, " +++   "but you are advised to first make a backup copy in case the CRC errors are actually " +++   "caused by bad data and the old CRCs might be useful in recovering that data.",+   "If you were warned about CRC errors during an operation involving another repository, " +++   "then it is possible that the other repository contains the corrupt CRCs, so you " +++   "should arrange for that repository to also be checked/repaired."+  ]++formatText :: [String] -> String+formatText = unlines . concat . intersperse [""] . map (map unwords . para 80 . words)++-- |Take a list of words and split it up so that each chunk fits into the specified width+-- when spaces are included. Any words longer than the specified width end up in a chunk+-- of their own.+para :: Int -> [[a]] -> [[[a]]]+para w = para'+  where para' [] = []+        para' xs = uncurry (:) $ para'' w xs+        para'' r (x:xs) | w == r || length x < r = ((x:) *** id) $ para'' (r - length x - 1) xs+        para'' _ xs = ([], para' xs)++-- |This is designed for use in an atexit handler, e.g. in Darcs.RunCommand+doCRCWarnings :: Bool -> IO ()+doCRCWarnings verbose = do+   files <- getCRCWarnings+   resetCRCWarnings+   when (not . null $ files) $ do+      putStr . formatText $+          ["",+           "Warning: CRC errors found. These are probably harmless but should " +++           "be repaired. See 'darcs gzcrcs --help' for more information.",+           ""]+      when verbose $ putStrLn $ unlines ("The following corrupt files were found:":files)++gzcrcs :: DarcsCommand+gzcrcs = DarcsCommand {command_name = "gzcrcs",+                       command_help = gzcrcs_help,+                       command_description = gzcrcs_description,+                       command_extra_args = 0,+                       command_extra_arg_help = [],+                       command_command = gzcrcs_cmd,+                       command_prereq = amInRepository,+                       command_get_arg_possibilities = return [],+                       command_argdefaults = nodefaults,+                       command_advanced_options = [],+                       command_basic_options = [check_or_repair,+                                                just_this_repo,+                                                working_repo_dir+                                               ]}++gzcrcs_cmd :: [DarcsFlag] -> [String] -> IO ()+gzcrcs_cmd opts _ | Check `elem` opts || Repair `elem` opts = withRepository opts (gzcrcs' opts)+gzcrcs_cmd _ _ = error "You must specify --check or --repair for gzcrcs"++#ifdef GADT_WITNESSES+gzcrcs' :: (RepoPatch p) => [DarcsFlag] -> Repository p r u t -> IO ()+#else+gzcrcs' :: (RepoPatch p) => [DarcsFlag] -> Repository p -> IO ()+#endif+gzcrcs' opts repo = do+  let Ca locs = extractCache repo+  ((), Any checkFailed) <- runWriterT $ flip mapM_ locs $ \loc -> do+    unless (JustThisRepo `elem` opts && not (isthisrepo loc)) $ do+     let w = writable loc+     flip mapM_ allHashedDirs $ \hdir -> do+        let dir = hashedFilePath loc hdir ""+        exists <- liftIO $ doesDirectoryExist dir+        when exists $ do+           liftIO $ putInfo $ text $ "Checking " ++ dir ++ (if w then "" else " (readonly)")+           files <- liftIO $ getDirectoryContents dir+           ((), Sum count) <- runWriterT $ flip mapM_ files $ \file -> do+              let fn = dir ++ file+              isfile <- liftIO $ doesFileExist fn+              when isfile $ do+                 gz <- liftIO $ isGZFile fn+                 case gz of+                    Nothing -> return ()+                    Just len -> do+                       contents <- liftIO $ B.readFile fn+                       let (uncompressed, isCorrupt) = gzDecompress (Just len) . BL.fromChunks $ [contents]+                       when isCorrupt $ do+                          tell (Sum 1) -- count of files in current directory+                          liftIO $ putVerbose $ text $ "Corrupt: " ++ fn+                          when (w && Repair `elem` opts) $ liftIO $ gzWriteAtomicFilePSs fn uncompressed+           when (count > (0 :: Int)) $ do+              liftIO $ putInfo $ text $+                 "Found " ++ show count ++ " corrupt file" ++ (if count > 1 then "s" else "") +++                 (if Repair `elem` opts then (if w then " (repaired)" else " (not repaired") else "")+              tell (Any True) -- something corrupt somewhere+  when (Check `elem` opts && checkFailed) $ exitWith $ ExitFailure 1++ where+     putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s+     putVerbose s = when (Verbose `elem` opts) $ putDocLn s++\end{code}
src/Darcs/Commands/Get.lhs view
@@ -15,12 +15,12 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs get}+\darcsCommand{get} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} -module Darcs.Commands.Get ( get ) where+module Darcs.Commands.Get ( get, clone ) where  import System.Directory ( setCurrentDirectory, doesDirectoryExist, doesFileExist,                           createDirectory )@@ -28,7 +28,7 @@ import Data.Maybe ( isJust ) import Control.Monad ( when ) -import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias ) import Darcs.Arguments ( DarcsFlag( NewRepo, Partial, Lazy,                                     UseFormat2, UseOldFashionedInventory, UseHashedInventory,                                     SetScriptsExecutable, Quiet, OnePattern ),@@ -60,40 +60,56 @@ import Darcs.SignalHandler ( catchInterrupt ) import Darcs.Commands.Init ( initialize ) import Darcs.Match ( have_patchset_match, get_one_patchset )-import Darcs.Utils ( catchall, formatPath, withCurrentDirectory )+import Darcs.Utils ( catchall, formatPath, withCurrentDirectory, prettyError ) import Progress ( debugMessage ) import Printer ( text, vcat, errorDoc, ($$), Doc, putDocLn, ) import Darcs.Lock ( writeBinFile ) import Darcs.RepoPath ( toFilePath, toPath, ioAbsoluteOrRemote) import Darcs.Sealed ( Sealed(..), unsafeUnflippedseal ) import Darcs.Global ( darcsdir )+import English ( englishNum, Noun(..) )+import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h"  get_description :: String-get_description =- "Create a local copy of another repository."-\end{code}--\options{get}--If the remote repository and the current directory are in the same filesystem and-that filesystem supports hard links, get will create hard links for the-patch files, which means that the additional storage space needed will be-minimal.  This is \emph{very} good for your disk usage (and for the speed-of running get), so if you want multiple copies of a repository, I strongly-recommend first running \verb!darcs get! to get yourself one copy, and then-running \verb!darcs get! on that copy to make any more you like.  The only-catch is that the first time you run \verb!darcs push! or \verb!darcs pull!-from any of these second copies, by default they will access your first-copy---which may not be what you want.--You may specify the name of the repository created by providing a second-argument to get, which is a directory name.+get_description = "Create a local copy of a repository." -\begin{code} get_help :: String get_help =- "Get is used to get a local copy of a repository.\n"+ "Get creates a local copy of a repository.  The optional second\n" +++ "argument specifies a destination directory for the new copy; if\n" +++ "omitted, it is inferred from the source location.\n" +++ "\n" +++ "By default Darcs will copy every patch from the original repository.\n" +++ "This means the copy is completely independent of the original; you can\n" +++ "operate on the new repository even when the original is inaccessible.\n" +++ "If you expect the original repository to remain accessible, you can\n" +++ "use --lazy to avoid copying patches until they are needed (`copy on\n" +++ "demand').  This is particularly useful when copying a remote\n" +++ "repository with a long history that you don't care about.\n" +++ "\n" +++ "The --lazy option isn't as useful for local copies, because Darcs will\n" +++ "automatically use `hard linking' where possible.  As well as saving\n" +++ "time and space, you can move or delete the original repository without\n" +++ "affecting a complete, hard-linked copy.  Hard linking requires that\n" +++ "the copy be on the same filesystem and the original repository, and\n" +++ "that the filesystem support hard linking.  This includes NTFS, HFS+\n" +++ "and all general-purpose Unix filesystems (such as ext3, UFS and ZFS).\n" +++ "FAT does not support hard links.\n" +++ "\n" +++ "Darcs get will not copy unrecorded changes to the source repository's\n" +++ "working tree.\n" +++ "\n" +++ get_help_tag +++ "\n" +++ -- The remaining help text covers backwards-compatibility options.+ get_help_partial +++ "\n" +++ "A repository created by `darcs get' will be in the best available\n" +++ "format: it will be able to exchange patches with the source\n" +++ "repository, but will not be directly readable by Darcs binaries older\n" +++ "than 2.0.0.  Use the `--old-fashioned-inventory' option if the latter\n" +++ "is required.\n"  get :: DarcsCommand get = DarcsCommand {command_name = "get",@@ -115,6 +131,9 @@                                              nolinks,                                              get_inventory_choices]} +clone :: DarcsCommand+clone = command_alias "clone" get+ get_cmd :: [DarcsFlag] -> [String] -> IO () get_cmd opts [inrepodir, outname] = get_cmd (NewRepo outname:opts) [inrepodir] get_cmd opts [inrepodir] = do@@ -134,8 +153,7 @@     putInfo $ text "Warning: 'old-fashioned-inventory' is ignored with a darcs-2 repository\n"   let opts' = if format_has Darcs2 rfsource               then UseFormat2:opts-              else if format_has HashedInventory rfsource &&-                      not (UseOldFashionedInventory `elem` opts)+              else if not (UseOldFashionedInventory `elem` opts)                    then UseHashedInventory:filter (/= UseFormat2) opts                    else UseOldFashionedInventory:filter (/= UseFormat2) opts   createRepository opts'@@ -163,7 +181,7 @@  get_cmd _ _ = fail "You must provide 'get' with either one or two arguments." --- called by get_cmd+-- | called by get_cmd -- assumes that the target repo of the get is the current directory, and that an inventory in the -- right format has already been created. copy_repo_and_go_to_chosen_version :: [DarcsFlag] -> String -> RepoFormat -> RepoFormat -> (Doc -> IO ()) -> IO ()@@ -213,27 +231,27 @@                return thename        else mrn n $ i+1     where thename = if i == -1 then n else n++"_"++show i-\end{code} -\begin{options}---context, --tag, --to-patch, --to-match-\end{options}-If you want to get a specific version of a repository, you have a few-options.  You can either use the \verb!--tag!, \verb!--to-patch! or-\verb!--to-match! options, or you can use the \verb!--context=FILENAME!-option, which specifies a file containing a context generated with-\verb!darcs changes --context!.  This allows you (for example) to include in-your compiled program an option to output the precise version of the-repository from which it was generated, and then perhaps ask users to-include this information in bug reports.--Note that when specifying \verb!--to-patch! or \verb!--to-match!, you may-get a version of your code that has never before been seen, if the patches-have gotten themselves reordered.  If you ever want to be able to precisely-reproduce a given version, you need either to tag it or create a context-file.+get_help_tag :: String+get_help_tag =+ "It is often desirable to make a copy of a repository that excludes\n" +++ "some patches.  For example, if releases are tagged then `darcs get\n" +++ "--tag .' would make a copy of the repository as at the latest release.\n" +++ "\n" +++ "An untagged repository state can still be identified unambiguously by\n" +++ "a context file, as generated by `darcs changes --context'.  Given the\n" +++ "name of such a file, the --context option will create a repository\n" +++ "that includes only the patches from that context.  When a user reports\n" +++ "a bug in an unreleased version of your project, the recommended way to\n" +++ "find out exactly what version they were running is to have them\n" +++ "include a context file in the bug report.\n" +++ "\n" +++ "You can also make a copy of an untagged state using the --to-patch or\n" +++ "--to-match options, which exclude patches `after' the first matching\n" +++ "patch.  Because these options treat the set of patches as an ordered\n" +++ "sequence, you may get different results after reordering with `darcs\n" +++ "optimize', so tagging is preferred.\n" -\begin{code} contextExists :: [DarcsFlag] -> IO (Either String ()) contextExists opts =    case get_context opts of@@ -257,7 +275,8 @@                         $$ (vcat $ mapRL description $ head $ unsafeUnRL them')        let ps = patchSetToPatches us'        putInfo $ text $ "Unapplying " ++ (show $ lengthFL ps) ++ " " ++-                   (patch_or_patches $ lengthFL ps)+                   (englishNum (lengthFL ps) (Noun "patch") "")+       invalidateIndex repository        withRepoLock opts $- \_ ->            do tentativelyRemovePatches repository opts ps               tentativelyAddToPending repository opts $ invert $ effect ps@@ -266,20 +285,15 @@                   fail ("Couldn't undo patch in working dir.\n" ++ show e)               sync_repo repository -patch_or_patches :: Int -> String-patch_or_patches 1 = "patch."-patch_or_patches _ = "patches." -\end{code}--\begin{options}---partial-\end{options}-Only get the patches since the last checkpoint. This will save time,-bandwidth and disk space, at the expense of losing the history before-the checkpoint.--\begin{code}+get_help_partial :: String+get_help_partial =+ "If the source repository is in a legacy darcs-1 format and contains at\n" +++ "least one checkpoint (see `darcs optimize'), the --partial option will\n" +++ "create a partial repository.  A partial repository discards history\n" +++ "from before the checkpoint in order to reduce resource requirements.\n" +++ "For modern darcs-2 repositories, --partial is a deprecated alias for\n" +++ "the --lazy option.\n"  copy_repo_old_fashioned :: RepoPatch p => Repository p -> [DarcsFlag] -> String -> IO () copy_repo_old_fashioned repository opts repodir = do@@ -319,7 +333,7 @@                                     get_patches_beyond_tag pi_ch local_patches                    in do write_checkpoint_patch p_ch                          apply opts p_ch `catch`-                             \e -> fail ("Bad checkpoint!\n" ++ show e)+                             \e -> fail ("Bad checkpoint!!!\n" ++ prettyError e)                          apply_patches opts needed_patches           else apply_patches opts $ reverseRL $ concatRL local_patches   debugMessage "Writing the pristine"
src/Darcs/Commands/Help.lhs view
@@ -15,40 +15,37 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs help}-\label{help}-+\darcsCommand{help} \begin{code}-module Darcs.Commands.Help ( help_cmd, command_control_list, print_version,-                             list_available_commands-                           ) where-import System.Exit ( ExitCode(..), exitWith )+module Darcs.Commands.Help (+ help_cmd,+ command_control_list, environmentHelp,          -- these are for preproc.hs+ print_version,+ list_available_commands ) where -import Autoconf( darcs_version )-import Darcs.Commands ( CommandControl(Command_data), DarcsCommand(..),-                        disambiguate_commands, CommandArgs(..),-                        get_command_help, extract_commands,-                       nodefaults, -                       usage )-import Darcs.Arguments ( DarcsFlag(..), help_on_match )+import Darcs.Arguments ( DarcsFlag(..), environmentHelpSendmail )+import Darcs.Commands (+ CommandArgs(..), CommandControl(..), DarcsCommand(..),+ disambiguate_commands, extract_commands, get_command_help, nodefaults, usage ) import Darcs.External ( viewDoc )+import Darcs.Lock ( environmentHelpTmpdir, environmentHelpKeepTmpdir ) import Darcs.Patch.Match ( helpOnMatchers )-import Darcs.Utils ( withCurrentDirectory )+import Darcs.Repository.Prefs ( binaries_file_help, environmentHelpHome )+import Darcs.Utils ( withCurrentDirectory, environmentHelpEditor, environmentHelpPager )+import Data.Char ( isAlphaNum, toLower )+import Data.List ( groupBy )+import English ( andClauses ) import Printer ( text )+import Ssh ( environmentHelpSsh, environmentHelpScp, environmentHelpSshPort )+import System.Exit ( ExitCode(..), exitWith )+import ThisVersion ( darcs_version )+import URL (environmentHelpProxy, environmentHelpProxyPassword) import Workaround ( getCurrentDirectory ) import qualified Darcs.TheCommands as TheCommands-\end{code} -\options{help}--\haskell{help_description}-\begin{code} help_description :: String help_description = "Display help about darcs and darcs commands."-\end{code}-\haskell{help_help}  -\begin{code} help_help :: String help_help =  "Without arguments, `darcs help' prints a categorized list of darcs\n" ++@@ -61,31 +58,29 @@                      command_description = help_description,                      command_extra_args = -1,                      command_extra_arg_help = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]]  "],-                     command_command = help_cmd,+                     command_command = \ x y -> help_cmd x y >> exitWith ExitSuccess,                      command_prereq = \_ -> return $ Right (),                      command_get_arg_possibilities = return [],                      command_argdefaults = nodefaults,                      command_advanced_options = [],-                     command_basic_options = [help_on_match]}+                     command_basic_options = []}  help_cmd :: [DarcsFlag] -> [String] -> IO ()-help_cmd opts [] =-    do viewDoc $ text $-         case () of _ | HelpOnMatch `elem` opts -> helpOnMatchers-                      | otherwise -> usage command_control_list-       exitWith $ ExitSuccess+help_cmd _ ["manpage"] = putStr $ unlines manpageLines+help_cmd _ ["patterns"] = viewDoc $ text $ helpOnMatchers+help_cmd _ ["environment"] = viewDoc $ text $ helpOnEnvironment+help_cmd _ [] = viewDoc $ text $ usage command_control_list  help_cmd _ (cmd:args) =-    do let disambiguated = disambiguate_commands command_control_list cmd args-       case disambiguated of-         Left err       -> fail err+    let disambiguated = disambiguate_commands command_control_list cmd args+    in case disambiguated of+         Left err -> fail err          Right (cmds,_) ->-           let msg = case cmds of-                     CommandOnly c       -> get_command_help Nothing  c-                     SuperCommandOnly c  -> get_command_help Nothing  c-                     SuperCommandSub c s -> get_command_help (Just c) s-           in viewDoc $ text msg-       exitWith $ ExitSuccess+             let msg = case cmds of+                         CommandOnly c       -> get_command_help Nothing  c+                         SuperCommandOnly c  -> get_command_help Nothing  c+                         SuperCommandSub c s -> get_command_help (Just c) s+             in viewDoc $ text msg  list_available_commands :: IO () list_available_commands =@@ -110,5 +105,162 @@ command_control_list :: [CommandControl]  command_control_list =   Command_data help : TheCommands.command_control_list-\end{code} +-- | Help on each environment variable in which Darcs is interested.+environmentHelp :: [([String], [String])]+environmentHelp = [+ -- General-purpose+ environmentHelpHome,+ environmentHelpEditor,+ environmentHelpPager,+ environmentHelpTmpdir,+ environmentHelpKeepTmpdir,+ environmentHelpSendmail,+ -- Remote Repositories+ environmentHelpSsh,+ environmentHelpScp,+ environmentHelpSshPort,+ environmentHelpProxy,+ environmentHelpProxyPassword]++-- | The rendered form of the data in 'environment_help'.+helpOnEnvironment :: String+helpOnEnvironment =+    "Environment Variables\n" +++    "=====================\n\n" +++    unlines [andClauses ks ++ ":\n" +++                     (unlines $ map ("  " ++) ds)+                     | (ks, ds) <- environmentHelp]++-- | This module is responsible for emitting a darcs "man-page", a+-- reference document used widely on Unix-like systems.  Manpages are+-- primarily used as a quick reference, or "memory jogger", so the+-- output should be terser than the user manual.+--+-- Before modifying the output, please be sure to read the man(7) and+-- man-pages(7) manpages, as these respectively describe the relevant+-- syntax and conventions.++-- | The lines of the manpage to be printed.+manpageLines :: [String]+manpageLines = [+ ".TH DARCS 1 \"" ++ darcs_version ++ "\"",+ ".SH NAME",+ "darcs \\- an advanced revision control system",+ ".SH SYNOPSIS",+ ".B darcs", ".I command", ".RI < arguments |[ options ]>...",+ "",+ "Where the", ".I commands", "and their respective", ".I arguments", "are",+ "",+ unlines synopsis,+ ".SH DESCRIPTION",+ -- FIXME: this is copy-and-pasted from darcs.cabal, so+ -- it'll get out of date as people forget to maintain+ -- both in sync.+ "Darcs is a free, open source revision control",+ "system. It is:",+ ".TP 3", "\\(bu",+ "Distributed: Every user has access to the full",+ "command set, removing boundaries between server and",+ "client or committer and non-committers.",+ ".TP", "\\(bu",+ "Interactive: Darcs is easy to learn and efficient to",+ "use because it asks you questions in response to",+ "simple commands, giving you choices in your work",+ "flow. You can choose to record one change in a file,",+ "while ignoring another. As you update from upstream,",+ "you can review each patch name, even the full `diff'",+ "for interesting patches.",+ ".TP", "\\(bu",+ "Smart: Originally developed by physicist David",+ "Roundy, darcs is based on a unique algebra of",+ "patches.",+ "This smartness lets you respond to changing demands",+ "in ways that would otherwise not be possible. Learn",+ "more about spontaneous branches with darcs.",+ ".SH OPTIONS",+ "Different options are accepted by different Darcs commands.",+ "Each command's most important options are listed in the",+ ".B COMMANDS",+ "section.  For a full list of all options accepted by",+ "a particular command, run `darcs", ".I command", "--help'.",+ ".SS " ++ helpOnMatchers, -- FIXME: this is a kludge.+ ".SH COMMANDS",+ unlines commands,+ unlines environment,+ ".SH FILES",+ ".SS \"_darcs/prefs/binaries\"",+ unlines binaries_file_help,+ ".SH BUGS",+ "At http://bugs.darcs.net/ you can find a list of known",+ "bugs in Darcs.  Unknown bugs can be reported at that",+ "site (after creating an account) or by emailing the",+ "report to bugs@darcs.net.",+ -- ".SH EXAMPLE",+ -- FIXME:+ -- new project: init, rec -la;+ -- track upstream project: get, pull -a;+ -- contribute to project: add, rec, push/send.+ ".SH SEE ALSO",+ "A user manual is included with Darcs, in PDF and HTML",+ "form.  It can also be found at http://darcs.net/manual/."]+    where+      -- | A synopsis line for each command.  Uses 'foldl' because it is+      -- necessary to avoid blank lines from Hidden_commands, as groff+      -- translates them into annoying vertical padding (unlike TeX).+      synopsis :: [String]+      synopsis = foldl iter [] command_control_list+          where iter :: [String] -> CommandControl -> [String]+                iter acc (Group_name _) = acc+                iter acc (Hidden_command _) = acc+                iter acc (Command_data c@SuperCommand {}) =+                    acc ++ concatMap+                            (render (command_name c ++ " "))+                            (extract_commands (command_sub_commands c))+                iter acc (Command_data c) = acc ++ render "" c+                render :: String -> DarcsCommand -> [String]+                render prefix c =+                    [".B darcs " ++ prefix ++ command_name c] +++                    (map mangle_args $ command_extra_arg_help c) +++                    -- In the output, we want each command to be on its own+                    -- line, but we don't want blank lines between them.+                    -- AFAICT this can only be achieved with the .br+                    -- directive, which is probably a GNUism.+                    [".br"]++      -- | As 'synopsis', but make each group a subsection (.SS), and+      -- include the help text for each command.+      commands :: [String]+      commands = foldl iter [] command_control_list+          where iter :: [String] -> CommandControl -> [String]+                iter acc (Group_name x) = acc ++ [".SS \"" ++ x ++ "\""]+                iter acc (Hidden_command _) = acc+                iter acc (Command_data c@SuperCommand {}) =+                    acc ++ concatMap+                            (render (command_name c ++ " "))+                            (extract_commands (command_sub_commands c))+                iter acc (Command_data c) = acc ++ render "" c+                render :: String -> DarcsCommand -> [String]+                render prefix c =+                    [".B darcs " ++ prefix ++ command_name c] +++                    (map mangle_args $ command_extra_arg_help c) +++                    [".RS 4", command_help c, ".RE"]++      -- | Now I'm showing off: mangle the extra arguments of Darcs commands+      -- so as to use the ideal format for manpages, italic words and roman+      -- punctuation.+      mangle_args :: String -> String+      mangle_args s =+          ".RI " ++ (unwords $ map show (groupBy cmp $ map toLower $ gank s))+              where cmp x y = not $ xor (isAlphaNum x) (isAlphaNum y)+                    xor x y = (x && not y) || (y && not x)+                    gank (' ':'o':'r':' ':xs) = '|' : gank xs+                    gank (x:xs) = x : gank xs+                    gank [] = []++      environment :: [String]+      environment = ".SH ENVIRONMENT" : concat+                    [(".SS \"" ++ andClauses ks ++ "\"") : ds+                     | (ks, ds) <- environmentHelp]++\end{code}
src/Darcs/Commands/Init.lhs view
@@ -15,35 +15,59 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs initialize}\label{initialize}+\darcsCommand{initialize} \begin{code} module Darcs.Commands.Init ( initialize, initialize_cmd ) where import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag, working_repo_dir,                         inventory_choices ) import Darcs.Repository ( amNotInRepository, createRepository )-\end{code} -\options{initialize}--\haskell{initialize_description}--\begin{code} initialize_description :: String-initialize_description = "Initialize a new source tree as a darcs repository."-\end{code}-Call \verb|initialize| once for each project you work on. Run it from the top-level directory of the project, with the project files already there. -\verb|initialize| will set up all the directories and files darcs needs in order to-start keeping track of revisions for your project.+initialize_description = "Make the current directory a repository." -\begin{code} initialize_help :: String initialize_help =- "Call initialize once for each project you work on. Run it from the top\n"++- "level directory of the project, with the project files already there.\n"++- "Initialize will set up all the directories and files darcs needs in order to\n"++- "start keeping track of revisions for your project.\n"+ "The `darcs initialize' command turns the current directory into a\n" +++ "Darcs repository.  Any existing files and subdirectories become\n" +++ "UNSAVED changes in the working tree: record them with `darcs add -r'\n" +++ "and `darcs record'.\n" +++ "\n" +++ -- FIXME: confirm my assertion re conversion is true. --twb, 2008-12-14+ "When converting a project to Darcs from some other VCS, translating\n" +++ "the full revision history to native Darcs patches is recommended.\n" +++ "(The Darcs wiki lists utilities for this.)  Because Darcs is optimized\n" +++ "for small patches, simply importing the latest revision as a single\n" +++ "large patch can PERMANENTLY degrade Darcs performance in your\n" +++ "repository by an order of magnitude.\n" +++ "\n" +++ "This command creates the `_darcs' directory, which stores version\n" +++ "control metadata.  It also contains per-repository settings in\n" +++ "_darcs/prefs/, which you can read about in the user manual.\n" +++ "\n" +++ "In addition to the default `darcs-2' format, there are two backward\n" +++ "compatibility formats for the _darcs directory.  These formats are\n" +++ "only useful if some of your contributors do not have access to Darcs\n" +++ "2.0 or higher.  In that case, you need to use the original format\n" +++ "(called `old-fashioned inventory' or `darcs-1') for any repositories\n" +++ "those contributors access.\n" +++ "\n" +++ "As patches cannot be shared between darcs-2 and darcs-1 repositories,\n" +++ "you cannot use the darcs-2 format for private branches of such a\n" +++ "project.  Instead, you should use the `hashed' format, which provides\n" +++ "most of the features of the darcs-2 format, while retaining the\n" +++ "ability to share patches with darcs-1 repositories.  The `darcs get'\n" +++ "command will do this by default.\n" +++ "\n" +++ "Once all contributors have access to Darcs 2.0 or higher, a darcs-1\n" +++ "project can be migrated to darcs-2 using the `darcs convert' command.\n" +++ "\n" +++ "Darcs will create a hashed repository by default when you `darcs get'\n" +++ "a repository in old-fashioned inventory format.  Once all contributors\n" +++ "have upgraded to Darcs 2.0 or later, use `darcs convert' to convert\n" +++ "the project to the darcs-2 format.\n" +++ "\n" +++ "Initialize is commonly abbreviated to `init'.\n"  initialize :: DarcsCommand initialize = DarcsCommand {command_name = "initialize",@@ -58,24 +82,7 @@                          command_advanced_options = [],                          command_basic_options = [inventory_choices,                                                   working_repo_dir]}-\end{code} -\verb|initialize| creates a single directory named \verb|_darcs|, with contents-for internal use. The one subdictory of interest to users is-\verb'_darcs/prefs', which will include an empty file \verb'_darcs/prefs/motd'-(see Section~\ref{motd}), as well as files named \verb'boring' and-\verb'binaries', which contain useful defaults as described in Sections-\ref{boring} \emph{et seq.}--\begin{options}---old-fashioned-inventory---hashed---darcs-2-\end{options}--These options force a particular repository format to be used.--\begin{code} initialize_cmd :: [DarcsFlag] -> [String] -> IO () initialize_cmd opts _ = createRepository opts \end{code}
src/Darcs/Commands/MarkConflicts.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs mark-conflicts}+\darcsCommand{mark-conflicts} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -40,21 +40,14 @@  markconflicts_description :: String markconflicts_description =- "Mark any unresolved conflicts in working copy, for manual resolution."-\end{code}--\options{mark-conflicts}--\haskell{mark-conflicts_help}+ "Mark unresolved conflicts in working tree, for manual resolution." -\begin{code} markconflicts_help :: String markconflicts_help =  "Darcs requires human guidance to unify changes to the same part of a\n" ++  "source file.  When a conflict first occurs, darcs will add both\n" ++- "choices to the working tree, delimited by markers.\n" ++- -- Removing this part of the sentence for now, because ^ ^ ^ upsets TeX.- --  the markers `v v v', `* * *' and `^ ^ ^'.\n"+ "choices to the working tree, delimited by the markers `v v v',\n" +++ "`* * *' and `^ ^ ^'.\n" ++  "\n" ++  "However, you might revert or manually delete these markers without\n" ++  "actually resolving the conflict.  In this case, `darcs mark-conflicts'\n" ++@@ -62,7 +55,7 @@  "if `darcs apply' is called with --apply-conflicts, where conflicts\n" ++  "aren't marked initially.\n" ++  "\n" ++- "Any unrecorded changes to the working tree *will* be lost forever when\n" +++ "Any unrecorded changes to the working tree WILL be lost forever when\n" ++  "you run this command!  You will be prompted for confirmation before\n" ++  "this takes place.\n" ++  "\n" ++
+ src/Darcs/Commands/Move.lhs view
@@ -0,0 +1,186 @@+%  Copyright (C) 2002-2003 David Roundy+%+%  This program is free software; you can redistribute it and/or modify+%  it under the terms of the GNU General Public License as published by+%  the Free Software Foundation; either version 2, or (at your option)+%  any later version.+%+%  This program is distributed in the hope that it will be useful,+%  but WITHOUT ANY WARRANTY; without even the implied warranty of+%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+%  GNU General Public License for more details.+%+%  You should have received a copy of the GNU General Public License+%  along with this program; see the file COPYING.  If not, write to+%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+%  Boston, MA 02110-1301, USA.++\darcsCommand{move}+\begin{code}+{-# OPTIONS_GHC -cpp #-}+{-# LANGUAGE CPP #-}++module Darcs.Commands.Move ( move, mv ) where+import Control.Monad ( when, unless, zipWithM_ )+import Data.Maybe ( catMaybes )+import Darcs.SignalHandler ( withSignalsBlocked )++import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias )+import Darcs.Arguments ( DarcsFlag( AllowCaseOnly, AllowWindowsReserved ),+                         fixSubPaths, working_repo_dir,+                        list_files, allow_problematic_filenames, umask_option,+                      )+import Darcs.RepoPath ( toFilePath, sp2fn )+import System.FilePath.Posix ( (</>), takeFileName )+import System.Directory ( renameDirectory )+import Workaround ( renameFile )+import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,+                    slurp_pending, add_to_pending,+                  )+import Darcs.Ordered ( FL(..), unsafeFL )+import Darcs.Global ( debugMessage )+import qualified Darcs.Patch+import Darcs.Patch ( RepoPatch, Prim )+import Darcs.SlurpDirectory ( Slurpy, slurp, slurp_has, slurp_has_anycase,+                        slurp_remove, slurp_hasdir, slurp_hasfile )+import Darcs.Patch.FileName ( fp2fn, fn2fp, super_name )+import qualified System.FilePath.Windows as WindowsFilePath++import Darcs.Gorsvet( invalidateIndex )+#include "impossible.h"++move_description :: String+move_description = "Move or rename files."++move_help :: String+move_help =+ "Darcs cannot reliably distinguish between a file being deleted and a\n" +++ "new one added, and a file being moved.  Therefore Darcs always assumes\n" +++ "the former, and provides the `darcs mv' command to let Darcs know when\n" +++ "you want the latter.  This command will also move the file in the\n" +++ "working tree (unlike `darcs remove').\n" +++ "\n" +++ -- Note that this paragraph is very similar to one in ./Add.lhs.+ "Darcs will not rename a file if another file in the same folder has\n" +++ "the same name, except for case.  The --case-ok option overrides this\n" +++ "behaviour.  Windows and OS X usually use filesystems that do not allow\n" +++ "files a folder to have the same name except for case (for example,\n" +++ "`ReadMe' and `README').  If --case-ok is used, the repository might be\n" +++ "unusable on those systems!\n"++move :: DarcsCommand+move = DarcsCommand {command_name = "move",+                   command_help = move_help,+                   command_description = move_description,+                   command_extra_args = -1,+                   command_extra_arg_help = ["<SOURCE> ... <DESTINATION>"],+                   command_command = move_cmd,+                   command_prereq = amInRepository,+                   command_get_arg_possibilities = list_files,+                   command_argdefaults = nodefaults,+                   command_advanced_options = [umask_option],+                   command_basic_options = [allow_problematic_filenames, working_repo_dir]}+move_cmd :: [DarcsFlag] -> [String] -> IO ()+move_cmd _ [] = fail "The `darcs move' command requires at least two arguments."+move_cmd _ [_] = fail "The `darcs move' command requires at least two arguments."++move_cmd opts args@[_,_] = withRepoLock opts $- \repository -> do+  two_files <- fixSubPaths opts args+  [old,new] <- return $ case two_files of+                        [_,_] -> two_files+                        [_] -> error "Cannot rename a file or directory onto itself!"+                        xs -> bug $ "Problem in move_cmd: " ++ show xs+  work <- slurp "."+  let old_fp = toFilePath old+      new_fp = toFilePath new+  if slurp_hasdir (sp2fn new) work && slurp_has old_fp work+   then move_to_dir repository opts [old_fp] new_fp+   else do+    cur <- slurp_pending repository+    addpatch <- check_new_and_old_filenames opts cur work (old_fp,new_fp)+    invalidateIndex repository+    withSignalsBlocked $ do+      case addpatch of+        Nothing -> add_to_pending repository (Darcs.Patch.move old_fp new_fp :>: NilFL)+        Just p -> add_to_pending repository (p :>: Darcs.Patch.move old_fp new_fp :>: NilFL)+      move_file_or_dir work old_fp new_fp++move_cmd opts args =+   withRepoLock opts $- \repository -> do+     relpaths <- map toFilePath `fmap` fixSubPaths opts args+     let moved = init relpaths+         finaldir = last relpaths+     move_to_dir repository opts moved finaldir++move_to_dir :: RepoPatch p => Repository p -> [DarcsFlag] -> [FilePath] -> FilePath -> IO ()+move_to_dir repository opts moved finaldir =+  let movefns = map takeFileName moved+      movetargets = map (finaldir </>) movefns+      movepatches = zipWith Darcs.Patch.move moved movetargets+  in do+    cur <- slurp_pending repository+    work <- slurp "."+    addpatches <- mapM (check_new_and_old_filenames opts cur work) $ zip moved movetargets+    invalidateIndex repository+    withSignalsBlocked $ do+      add_to_pending repository $ unsafeFL $ catMaybes addpatches ++ movepatches+      zipWithM_ (move_file_or_dir work) moved movetargets++check_new_and_old_filenames+    :: [DarcsFlag] -> Slurpy -> Slurpy -> (FilePath, FilePath) -> IO (Maybe Prim)+check_new_and_old_filenames opts cur work (old,new) = do+  unless (AllowWindowsReserved `elem` opts || WindowsFilePath.isValid new) $+     fail $ "The filename " ++ new ++ " is not valid under Windows.\n" +++            "Use --reserved-ok to allow such filenames."+  maybe_add_file_thats_been_moved <-+     if slurp_has old work -- We need to move the object+     then do unless (slurp_hasdir (super_name $ fp2fn new) work) $+                    fail $ "The target directory " +++                             (fn2fp $ super_name $ fp2fn new)+++                             " isn't known in working directory, did you forget to add it?"+             when (it_has new work) $ fail $ already_exists "working directory"+             return Nothing+     else do unless (slurp_has new work) $ fail $ doesnt_exist "working directory"+             return $ Just $ Darcs.Patch.addfile old+  if slurp_has old cur+     then do unless (slurp_hasdir (super_name $ fp2fn new) cur) $+                    fail $ "The target directory " +++                             (fn2fp $ super_name $ fp2fn new)+++                             " isn't known in working directory, did you forget to add it?"+             when (it_has new cur) $ fail $ already_exists "repository"+     else fail $ doesnt_exist "repository"+  return maybe_add_file_thats_been_moved+    where it_has f s = +            let ms2 = slurp_remove (fp2fn old) s+            in case ms2 of+               Nothing -> False+               Just s2 -> if AllowCaseOnly `elem` opts +                          then slurp_has f s2+                          else slurp_has_anycase f s2+          already_exists what_slurpy =+              if AllowCaseOnly `elem` opts+              then "A file or dir named "++new++" already exists in "+                       ++ what_slurpy ++ "."+              else "A file or dir named "++new++" (or perhaps differing"+++                       " only in case)\nalready exists in "+++                       what_slurpy ++ ".\n"+++                   "Use --case-ok to allow files differing only in case."+          doesnt_exist what_slurpy =+              "There is no file or dir named " ++ old +++              " in the "++ what_slurpy ++ "."++move_file_or_dir :: Slurpy -> FilePath -> FilePath -> IO ()+move_file_or_dir work old new =+    if slurp_hasfile (fp2fn old) work+       then do debugMessage $ unwords ["renameFile",old,new]+               renameFile old new+       else if slurp_hasdir (fp2fn old) work+            then do debugMessage $ unwords ["renameDirectory",old,new]+                    renameDirectory old new+            else return ()++mv :: DarcsCommand+mv = command_alias "mv" move+\end{code}++
− src/Darcs/Commands/Mv.lhs 
@@ -1,205 +0,0 @@-%  Copyright (C) 2002-2003 David Roundy-%-%  This program is free software; you can redistribute it and/or modify-%  it under the terms of the GNU General Public License as published by-%  the Free Software Foundation; either version 2, or (at your option)-%  any later version.-%-%  This program is distributed in the hope that it will be useful,-%  but WITHOUT ANY WARRANTY; without even the implied warranty of-%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-%  GNU General Public License for more details.-%-%  You should have received a copy of the GNU General Public License-%  along with this program; see the file COPYING.  If not, write to-%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,-%  Boston, MA 02110-1301, USA.--\subsection{darcs mv}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Mv ( mv, move ) where-import Control.Monad ( when, unless )-import Data.Maybe ( catMaybes )-import Darcs.SignalHandler ( withSignalsBlocked )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag( AllowCaseOnly, AllowWindowsReserved ),-                         fixSubPaths, working_repo_dir,-                        list_files, allow_problematic_filenames, umask_option,-                      )-import Darcs.RepoPath ( toFilePath, sp2fn )-import System.FilePath.Posix ( (</>), takeFileName )-import System.Directory ( renameDirectory )-import Workaround ( renameFile )-import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,-                    slurp_pending, add_to_pending,-                  )-import Darcs.Ordered ( FL(..), unsafeFL )-import Darcs.Global ( debugMessage )-import qualified Darcs.Patch-import Darcs.Patch ( RepoPatch, Prim )-import Darcs.SlurpDirectory ( Slurpy, slurp, slurp_has, slurp_has_anycase,-                        slurp_remove, slurp_hasdir, slurp_hasfile )-import Darcs.Patch.FileName ( fp2fn, fn2fp, super_name )-import qualified System.FilePath.Windows as WindowsFilePath-#include "impossible.h"--mv_description :: String-mv_description =- "Move/rename one or more files or directories."-\end{code}--\options{mv}--\haskell{mv_help} This is why ``mv'' isn't called ``move'', since it is-really almost equivalent to the unix command ``mv''.--\begin{options}---case-ok-\end{options}--Darcs mv will by default refuse to rename a file if there already exists a-file having the same name apart from case.  This is because doing so could-create a repository that could not be used on file systems that are case-insensitive (such as Apple's HFS+).  You can override this by with the flag-\verb!--case-ok!.--\begin{code}-mv_help :: String-mv_help =- "Darcs mv needs to be called whenever you want to move files or\n"++- "directories. Unlike remove, mv actually performs the move itself in your\n"++- "working copy.\n"--mv :: DarcsCommand-mv = DarcsCommand {command_name = "mv",-                   command_help = mv_help,-                   command_description = mv_description,-                   command_extra_args = -1,-                   command_extra_arg_help = ["[FILE or DIRECTORY]..."],-                   command_command = mv_cmd,-                   command_prereq = amInRepository,-                   command_get_arg_possibilities = list_files,-                   command_argdefaults = nodefaults,-                   command_advanced_options = [umask_option],-                   command_basic_options = [allow_problematic_filenames, working_repo_dir]}-mv_cmd :: [DarcsFlag] -> [String] -> IO ()-mv_cmd _ [] = fail "You must specify at least two arguments for mv"-mv_cmd _ [_] = fail "You must specify at least two arguments for mv"--mv_cmd opts args@[_,_] = withRepoLock opts $- \repository -> do-  two_files <- fixSubPaths opts args-  [old,new] <- return $ case two_files of-                        [_,_] -> two_files-                        [_] -> error "Cannot rename a file or directory onto itself!"-                        xs -> bug $ "Problem in mv_cmd: " ++ show xs-  work <- slurp "."-  let old_fp = toFilePath old-      new_fp = toFilePath new-  if slurp_hasdir (sp2fn new) work && slurp_has old_fp work-   then move_to_dir repository opts [old_fp] new_fp-   else do-    cur <- slurp_pending repository-    addpatch <- check_new_and_old_filenames opts cur work (old_fp,new_fp)-    withSignalsBlocked $ do-      case addpatch of-        Nothing -> add_to_pending repository (Darcs.Patch.move old_fp new_fp :>: NilFL)-        Just p -> add_to_pending repository (p :>: Darcs.Patch.move old_fp new_fp :>: NilFL)-      move_file_or_dir work old_fp new_fp--mv_cmd opts args =-   withRepoLock opts $- \repository -> do-     relpaths <- map toFilePath `fmap` fixSubPaths opts args-     let moved = init relpaths-         finaldir = last relpaths-     move_to_dir repository opts moved finaldir--move_to_dir :: RepoPatch p => Repository p -> [DarcsFlag] -> [FilePath] -> FilePath -> IO ()-move_to_dir repository opts moved finaldir =-  let movefns = map takeFileName moved-      movetargets = map (finaldir </>) movefns-      movepatches = zipWith Darcs.Patch.move moved movetargets-  in do-    cur <- slurp_pending repository-    work <- slurp "."-    addpatches <- mapM (check_new_and_old_filenames opts cur work) $ zip moved movetargets-    withSignalsBlocked $ do-      add_to_pending repository $ unsafeFL $ catMaybes addpatches ++ movepatches-      sequence_ $ zipWith (move_file_or_dir work) moved movetargets--check_new_and_old_filenames-    :: [DarcsFlag] -> Slurpy -> Slurpy -> (FilePath, FilePath) -> IO (Maybe Prim)-check_new_and_old_filenames opts cur work (old,new) = do-  unless (AllowWindowsReserved `elem` opts || WindowsFilePath.isValid new) $-     fail $ "The filename " ++ new ++ " is not valid under Windows.\n" ++-            "Use --reserved-ok to allow such filenames."-  maybe_add_file_thats_been_moved <--     if slurp_has old work -- We need to move the object-     then do unless (slurp_hasdir (super_name $ fp2fn new) work) $-                    fail $ "The target directory " ++-                             (fn2fp $ super_name $ fp2fn new)++-                             " isn't known in working directory, did you forget to add it?"-             when (it_has new work) $ fail $ already_exists "working directory"-             return Nothing-     else do unless (slurp_has new work) $ fail $ doesnt_exist "working directory"-             return $ Just $ Darcs.Patch.addfile old-  if slurp_has old cur-     then do unless (slurp_hasdir (super_name $ fp2fn new) cur) $-                    fail $ "The target directory " ++-                             (fn2fp $ super_name $ fp2fn new)++-                             " isn't known in working directory, did you forget to add it?"-             when (it_has new cur) $ fail $ already_exists "repository"-     else fail $ doesnt_exist "repository"-  return maybe_add_file_thats_been_moved-    where it_has f s = -            let ms2 = slurp_remove (fp2fn old) s-            in case ms2 of-               Nothing -> False-               Just s2 -> if AllowCaseOnly `elem` opts -                          then slurp_has f s2-                          else slurp_has_anycase f s2-          already_exists what_slurpy =-              if AllowCaseOnly `elem` opts-              then "A file or dir named "++new++" already exists in "-                       ++ what_slurpy ++ "."-              else "A file or dir named "++new++" (or perhaps differing"++-                       " only in case)\nalready exists in "++-                       what_slurpy ++ ".\n"++-                   "Use --case-ok to allow files differing only in case."-          doesnt_exist what_slurpy =-              "There is no file or dir named " ++ old ++-              " in the "++ what_slurpy ++ "."--move_file_or_dir :: Slurpy -> FilePath -> FilePath -> IO ()-move_file_or_dir work old new =-    if slurp_hasfile (fp2fn old) work-       then do debugMessage $ unwords ["renameFile",old,new]-               renameFile old new-       else if slurp_hasdir (fp2fn old) work-            then do debugMessage $ unwords ["renameDirectory",old,new]-                    renameDirectory old new-            else return ()-\end{code}---% move - Note: not a subsection because not to be documented.--\begin{code}-move_description :: String-move_description =- "Alias for 'mv'"--move_help :: String-move_help =- "Alias for 'mv'\n" ++ mv_help--move :: DarcsCommand-move = mv {command_name = "move",-           command_help = move_help,-           command_description = move_description }-\end{code}--
src/Darcs/Commands/Optimize.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs optimize}+\darcsCommand{optimize} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -63,18 +63,30 @@ #include "impossible.h"  optimize_description :: String-optimize_description =- "Optimize the repository."-\end{code}--\options{optimize}--\haskell{optimize_help}+optimize_description = "Optimize the repository." -\begin{code} optimize_help :: String optimize_help =- "Optimize can help to improve the performance of your repository in a number of cases.\n"+ "The `darcs optimize' command modifies the current repository in an\n" +++ "attempt to reduce its resource requirements.  By default a single\n" +++ "fast, safe optimization is performed; additional optimization\n" +++ "techniques can be enabled by passing options to `darcs optimize'.\n" +++ "\n" ++ optimize_help_inventory +++ -- "\n" ++ optimize_help_reorder +++ "\n" ++ optimize_help_relink +++ -- checkpoints and uncompression are least useful, so they are last.+ "\n" ++ optimize_help_compression +++ "\n" ++ optimize_help_checkpoint +++ "\n" +++ "There is one more optimization which CAN NOT be performed by this\n" +++ "command.  Every time your record a patch, a new inventory file is\n" +++ "written to _darcs/inventories/, and old inventories are never reaped.\n" +++ "\n" +++ "If _darcs/inventories/ is consuming a relatively large amount of\n" +++ "space, you can safely reclaim it by using `darcs get' to make a\n" +++ "complete copy of the repo.  When doing so, don't forget to copy over\n" +++ "any unsaved changes you have made to the working tree or to\n" +++ "unversioned files in _darcs/prefs/ (such as _darcs/prefs/author).\n"  optimize :: DarcsCommand optimize = DarcsCommand {command_name = "optimize",@@ -107,47 +119,29 @@   where opts = if UnCompress `elem` origopts then NoCompress:origopts else origopts is_tag :: PatchInfo -> Bool is_tag pinfo = take 4 (just_name pinfo) == "TAG "-\end{code} -Optimize always writes out a fresh copy of the inventory that minimizes-the amount of inventory that need be downloaded when people pull from the-repository.--Specifically, it breaks up the inventory on the most recent tag.  This speeds-up most commands when run remotely, both because a smaller file needs to be-transfered (only the most recent inventory).  It also gives a-guarantee that all the patches prior to a given tag are included in that tag,-so less commutation and history traversal is needed.  This latter issue can-become very important in large repositories.+optimize_help_inventory :: String+optimize_help_inventory =+ "The default optimization moves recent patches (those not included in\n" +++ "the latest tag) to the `front', reducing the amount that a typical\n" +++ "remote command needs to download.  It should also reduce the CPU time\n" +++ "needed for some operations.\n" -\begin{code} do_optimize_inventory :: RepoPatch p => Repository p -> IO () do_optimize_inventory repository = do     debugMessage "Writing out a nice copy of the inventory."     optimizeInventory repository     debugMessage "Done writing out a nice copy of the inventory."-\end{code} -\begin{options}---checkpoint, --tag-\end{options}--If you use the \verb!--checkpoint! option, optimize creates a checkpoint patch-for a tag.  You can specify the tag with the \verb!--tag! option, or-just let darcs choose the most recent tag.  Note that optimize-\verb!--checkpoint! will fail when used on a ``partial'' repository.  Also,-the tag that is to be checkpointed must not be preceded by any patches-that are not included in that tag.  If that is the case, no checkpointing-is done.--The created checkpoint is used by the \verb!--partial! flag to -\verb!get! and \verb!check!. This allows for users to retrieve-a working repository with limited history with a savings of disk-space and bandwidth. --+optimize_help_checkpoint :: String+optimize_help_checkpoint =+ "If the repository is in `old-fashioned-inventory' format, the `darcs\n" +++ "optimize --checkpoint' command creates a checkpoint of the latest tag.\n" +++ "This checkpoint is used by `darcs get --partial' to create partial\n" +++ "repositories.  With the `--tag' option, checkpoints for older tags can\n" +++ "be created.  In newer repository formats, this feature has been\n" +++ "replaced by `darcs get --lazy', which does not require checkpoints.\n" -\begin{code} do_checkpoint :: RepoPatch p => [DarcsFlag] -> Repository p -> IO () do_checkpoint opts repository = do     mpi <- get_tag opts repository@@ -187,34 +181,21 @@ match_tag :: String -> PatchInfo -> Bool match_tag ('^':n) = mymatch $ "^TAG "++n match_tag n = mymatch $ "^TAG .*"++n-\end{code} -\begin{options}---compress, --dont-compress, --uncompress-\end{options} -Some compression options are available, and are independent of the-\verb!--checkpoint! option.--By default the patches in the repository are compressed. These use less-disk space, which translates into less bandwidth if the repository is accessed-remotely.--Note that in the darcs-1.0 (also known as ``old fashioned inventory'')-repository format, patches will always have the ``.gz'' extension whether-they are compressed or not.--You may want to uncompress the patches when you've got enough disk space but-are running out of physical memory.--If you give the \verb!--compress! option, optimize will compress all the-patches in the repository.  Similarly, if you give the \verb!--uncompress!,-optimize will decompress all the patches in the repository.-\verb!--dont-compress!  means ``don't compress, but don't uncompress-either''. It would be useful if one of the compression options was provided-as a default and you wanted to override it.+optimize_help_compression :: String+optimize_help_compression =+ "By default patches are compressed with zlib (RFC 1951) to reduce\n" +++ "storage (and download) size.  In exceptional circumstances, it may be\n" +++ "preferable to avoid compression.  In this case the `--dont-compress'\n" +++ "option can be used (e.g. with `darcs record') to avoid compression.\n" +++ "\n" +++ "The `darcs optimize --uncompress' and `darcs optimize --compress'\n" +++ "commands can be used to ensure existing patches in the current\n" +++ "repository are respectively uncompressed or compressed.  Note that\n" +++ "repositories in the legacy `old-fashioned-inventory' format have a .gz\n" +++ "extension on patch files even when uncompressed.\n" -\begin{code} optimize_compression :: [DarcsFlag] -> IO () optimize_compression opts = do     putStrLn "Optimizing (un)compression of patches..."@@ -232,17 +213,22 @@           notdot ('.':_) = False           notdot _ = True -\end{code}--\begin{options}---relink-\end{options}--The \verb|--relink| and \verb|--relink-pristine| options cause Darcs-to relink files from a sibling.  See Section \ref{disk-usage}.-+optimize_help_relink :: String+optimize_help_relink =+ "The `darcs optimize --relink' command hard-links patches that the\n" +++ "current repository has in common with its peers.  Peers are those\n" +++ "repositories listed in _darcs/prefs/sources, or defined with the\n" +++ "`--sibling' option (which can be used multiple times).\n" +++ "\n" +++ "Darcs uses hard-links automatically, so this command is rarely needed.\n" +++ "It is most useful if you used `cp -r' instead of `darcs get' to copy a\n" +++ "repository, or if you pulled the same patch from a remote repository\n" +++ "into multiple local repositories.\n" +++ "\n" +++ "A `darcs optimize --relink-pristine' command is also available, but\n" +++ "generally SHOULD NOT be used.  It results in a relatively small space\n" +++ "saving at the cost of making many Darcs commands MUCH slower.\n" -\begin{code} do_relink :: RepoPatch p => [DarcsFlag] -> Repository p -> IO () do_relink opts repository =     do some_siblings <- return (flagsToSiblings opts)@@ -279,8 +265,9 @@        unless done $            maybeRelinkFile t f        return ()-\end{code} ++\end{code} \begin{options} --reorder-patches \end{options}@@ -291,8 +278,17 @@ other operations as well.  You should not run \verb!--reorder-patches! on a repository from which someone may be simultaneously pulling or getting, as this could lead to repository corruption.- \begin{code}++-- FIXME: someone needs to grovel through the source and determine+-- just how optimizeInventory differs from do_reorder.  The following+-- is purely speculation. --twb, 2009-04+-- optimize_help_reorder :: String+-- optimize_help_reorder =+--  "The `darcs optimize --reorder' command is a more comprehensive version\n" +++--  "of the default optimization.  It reorders patches with respect to ALL\n" +++--  "tags, rather than just the latest tag.\n"+ do_reorder :: RepoPatch p => [DarcsFlag] -> Repository p -> IO () do_reorder opts _ | not (Reorder `elem` opts) = return () do_reorder opts repository = do
src/Darcs/Commands/Pull.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs pull}+\darcsCommand{pull} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -38,12 +38,12 @@                          test, dry_run,                          set_default, summary, working_repo_dir, remote_repo,                          set_scripts_executable, nolinks,-                         network_options, umask_option, allow_unrelated_repos+                         network_options, umask_option, allow_unrelated_repos, restrict_paths                       ) import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf,                           amInRepository, withRepoLock, ($-), tentativelyMergePatches,                           sync_repo, finalizeRepositoryChanges, applyToWorking,-                          slurp_recorded, read_repo, checkUnrelatedRepos )+                          read_repo, checkUnrelatedRepos ) import Darcs.Hopefully ( info ) import Darcs.Patch ( RepoPatch, description ) import Darcs.Ordered ( (:>)(..), (:\/:)(..), RL(..), unsafeUnRL, concatRL,@@ -58,17 +58,13 @@ import Darcs.Utils ( clarify_errors, formatPath ) import Darcs.Sealed ( Sealed(..), seal ) import Printer ( putDocLn, vcat, ($$), text )+import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h"  pull_description :: String pull_description =  "Copy and apply patches from another repository to this one."-\end{code} -\options{pull}--\haskell{pull_help}-\begin{code} pull_help :: String pull_help =  "Pull is used to bring changes made in another repository into the current\n"++@@ -94,7 +90,8 @@                                                  ignoretimes,                                                  remote_repo,                                                  set_scripts_executable,-                                                 umask_option] +++                                                 umask_option,+                                                 restrict_paths] ++                                                 network_options,                      command_basic_options = [match_several,                                               all_interactive,@@ -125,7 +122,7 @@   when (old_default == repodirs) $       let pulling = if DryRun `elem` opts then "Would pull" else "Pulling"       in  putInfo $ text $ pulling++" from "++concatMap formatPath repodirs++"..."-  mapM (show_motd opts) repodirs+  mapM_ (show_motd opts) repodirs   us <- read_repo repository   (common, us' :\/: them'') <- return $ get_common_and_uncommon (us, them)   (_     ,   _ :\/: compl') <- return $ get_common_and_uncommon (us, compl)@@ -142,8 +139,7 @@      when (nullFL ps) $ do putInfo $ text "No remote changes to pull in!"                            definePatches ps                            exitWith ExitSuccess-     s <- slurp_recorded repository-     with_selected_changes "pull" opts s ps $+     with_selected_changes "pull" opts ps $       \ (to_be_pulled:>_) -> do       print_dry_run_message_and_exit "pull" opts to_be_pulled       definePatches to_be_pulled@@ -158,6 +154,7 @@                      | otherwise                    = MarkConflicts : opts       Sealed pw <- tentativelyMergePatches repository "pull" merge_opts                    (reverseRL $ head $ unsafeUnRL us') to_be_pulled+      invalidateIndex repository       withGutsOf repository $ do finalizeRepositoryChanges repository                                  -- so work will be more recent than rec:                                  revertable $ do wait_a_moment
src/Darcs/Commands/Push.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs push}+\darcsCommand{push} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -36,7 +36,7 @@                          set_default, sign, allow_unrelated_repos                       ) import Darcs.Hopefully ( hopefully )-import Darcs.Repository ( withRepoReadLock, ($-), identifyRepositoryFor, slurp_recorded,+import Darcs.Repository ( withRepoReadLock, ($-), identifyRepositoryFor,                           read_repo, amInRepository, checkUnrelatedRepos ) import Darcs.Patch ( description ) import Darcs.Ordered ( RL(..), (:>)(..), (:\/:)(..),@@ -57,11 +57,7 @@ push_description :: String push_description =  "Copy and apply patches from this repository to another one."-\end{code} -\options{push}-\haskell{push_help}-\begin{code} push_help :: String push_help =  "Push is the opposite of pull.  Push allows you to copy changes from the\n"++@@ -101,7 +97,7 @@  -- Test to make sure we aren't trying to push to the current repo  here <- getCurrentDirectory  when (repodir == here) $-       fail "Can't push to current repository!"+       fail "Cannot push from repository to itself."        -- absolute '.' also taken into account by fix_filepath  (bundle,num_to_pull) <- withRepoReadLock opts $- \repository -> do   if is_url repodir then do@@ -145,8 +141,7 @@                                        exitWith ExitSuccess                    NilRL -> bug "push_cmd: us' is empty!"                    (x:<:_) -> return x-     s <- slurp_recorded repository-     with_selected_changes "push" opts s (reverseRL firstUs) $+     with_selected_changes "push" opts (reverseRL firstUs) $       \ (to_be_pushed:>_) -> do       definePatches to_be_pushed       print_dry_run_message_and_exit "push" opts to_be_pushed
src/Darcs/Commands/Put.lhs view
@@ -1,4 +1,4 @@-\subsection{darcs put}+\darcsCommand{put} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -37,10 +37,7 @@ put_description :: String  put_description =  "Makes a copy of the repository"-\end{code}-\options{put}-\haskell{put_help}-\begin{code}+ put_help :: String put_help =  "The `darcs put' command creates a copy of the current repository.  It\n" ++@@ -95,7 +92,7 @@                 else if format_has HashedInventory rf &&                         not (UseOldFashionedInventory `elem` opts)                      then UseHashedInventory:filter (/= UseFormat2) opts-                     else filter (/= UseFormat2) opts+                     else UseOldFashionedInventory:filter (/= UseFormat2) opts  if is_file req_absolute_repo_dir      then do createDirectory req_absolute_repo_dir              withCurrentDirectory req_absolute_repo_dir $ (command_command initialize) initopts []
src/Darcs/Commands/Record.lhs view
@@ -15,8 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs record}-\label{record}+\darcsCommand{record} \begin{code} {-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, PatternGuards #-}@@ -26,7 +25,7 @@ import Control.Monad ( filterM, when ) import System.IO ( hGetContents, stdin ) import Data.List ( sort, isPrefixOf )-import System.Exit ( exitFailure, ExitCode(..) )+import System.Exit ( exitWith, exitFailure, ExitCode(..) ) import System.IO ( hPutStrLn ) import System.Directory ( doesFileExist, doesDirectoryExist, removeFile ) import Data.Maybe ( isJust )@@ -34,7 +33,8 @@ import Darcs.Lock ( readBinFile, writeBinFile, world_readable_temp, appendToFile, removeFileMayNotExist ) import Darcs.Hopefully ( info, n2pia ) import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),-                          get_unrecorded, get_unrecorded_unsorted, withGutsOf,+                          get_unrecorded_in_files,+                          get_unrecorded_in_files_unsorted, withGutsOf,                     sync_repo, read_repo,                     slurp_recorded,                     tentativelyAddPatch, finalizeRepositoryChanges,@@ -68,6 +68,7 @@ import Darcs.ProgressPatches( progressFL) import IsoDate ( getIsoDateTime, cleanLocalDate ) import Printer ( hPutDocLn, text, wrap_text, ($$), renderString )+import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h"  record_description :: String@@ -75,8 +76,6 @@  "Save changes in the working copy to the repository as a patch." \end{code} -\options{record}- If you provide one or more files or directories as additional arguments to record, you will only be prompted to changes in those files or directories.@@ -116,9 +115,9 @@ commit_help :: String commit_help =  "This command does not do anything.\n"++- "If you want to save changes locally, use the 'darcs record' command.\n"+++ "If you want to save changes locally, use the `darcs record' command.\n"++  "If you want to save a recorded patch to another repository, use the\n"++- "'darcs push' or 'darcs send' commands instead.\n"+ "`darcs push' or `darcs send' commands instead.\n"  commit :: DarcsCommand commit = command_stub "commit" commit_help commit_description record@@ -149,8 +148,9 @@     when (((not $ null non_existent_files) || (not $ null non_repo_files)) && null existing_files) $          fail "None of the files you specified exist!"     debugMessage "About to get the unrecorded changes."-    changes <- if All `elem` opts then get_unrecorded_unsorted repository-                                  else get_unrecorded repository+    let existing_fns = map sp2fn existing_files+    changes <- if All `elem` opts then get_unrecorded_in_files_unsorted repository existing_fns+                                  else get_unrecorded_in_files repository existing_fns     debugMessage "I've gotten unrecorded."     case allow_empty_with_askdeps changes of       Nothing -> do when (Pipe `elem` opts) $ do get_date opts@@ -193,13 +193,13 @@     date <- get_date opts     my_author <- get_author opts     debugMessage "I'm slurping the repository."-    s <- slurp_recorded repository     debugMessage "About to select changes..."     with_selected_changes_to_files' "record" opts-      s (map toFilePath files) ps $ \ (chs:>_) ->-      if is_empty_but_not_askdeps chs-        then putStrLn "Ok, if you don't want to record anything, that's fine!"-        else handleJust only_successful_exits (\_ -> return ()) $+      (map toFilePath files) ps $ \ (chs:>_) ->+      do when (is_empty_but_not_askdeps chs) $+              do putStrLn "Ok, if you don't want to record anything, that's fine!"+                 exitWith ExitSuccess+         handleJust only_successful_exits (\_ -> return ()) $              do deps <- if AskDeps `elem` opts                         then ask_about_depends repository chs opts                         else return []@@ -223,6 +223,7 @@                  mypatch <- namepatch date name my_author my_log $                             fromPrims $ progressFL "Writing changes:" chs                  tentativelyAddPatch repository opts $ n2pia $ adddeps mypatch deps+                 invalidateIndex repository                  debugMessage "Applying to pristine..."                  withGutsOf repository (finalizeRepositoryChanges repository)                                     `clarify_errors` failuremessage@@ -322,7 +323,7 @@                     FlagPatchName  p                         | Just ("",_) <- m_old ->                                        return (p, default_log, Nothing) -- rollback -m-                    FlagPatchName  p -> return (p, [], Nothing) -- record (or amend) -m+                    FlagPatchName  p -> return (p, default_log, Nothing) -- record (or amend) -m                     PriorPatchName p -> return (p, default_log, Nothing) -- amend                     NoPatchName      -> do p <- prompt_patchname True -- record                                            return (p, [], Nothing)@@ -332,7 +333,7 @@                     _               -> gl fs           gl (_:fs) = gl fs           gl [] = case patchname_specified of-                    FlagPatchName  p -> return (p, [], Nothing)  -- record (or amend) -m+                    FlagPatchName  p -> return (p, default_log, Nothing)  -- record (or amend) -m                     PriorPatchName "" -> prompt_patchname True >>= prompt_long_comment                     PriorPatchName p -> return (p, default_log, Nothing)                     NoPatchName -> prompt_patchname True >>= prompt_long_comment@@ -418,7 +419,7 @@                 [] -> error "ask_about_depends: []"                 _ -> error "ask_about_depends: many"       ps' = mapFL_FL tp_patch $ middle_choice $ force_first ta pc-  with_selected_changes_reversed "depend on" (filter askdep_allowed opts) empty_slurpy ps'+  with_selected_changes_reversed "depend on" (filter askdep_allowed opts) ps'              $ \(deps:>_) -> return $ mapFL info deps  where headRL (x:<:_) = x        headRL NilRL = impossible
src/Darcs/Commands/Remove.lhs view
@@ -15,13 +15,14 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs remove}+\darcsCommand{remove} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}  module Darcs.Commands.Remove ( remove, rm, unadd ) where +import Control.Monad ( when ) import Darcs.Commands ( DarcsCommand(..), nodefaults,                         command_alias, command_stub,                       )@@ -31,31 +32,29 @@                       ) import Darcs.RepoPath ( SubPath, toFilePath, sp2fn ) import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,-                          slurp_pending, slurp_recorded, get_unrecorded, add_to_pending )+                          slurp_pending, slurp_recorded,+                          get_unrecorded_in_files, add_to_pending ) import Darcs.Patch ( RepoPatch, Prim, apply_to_slurpy, adddir, rmdir, addfile, rmfile ) import Darcs.Ordered ( FL(..), (+>+) ) import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile ) import Darcs.Repository.Prefs ( filetype_function ) import Darcs.Diff ( unsafeDiff )+import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h"  remove_description :: String-remove_description =- "Remove one or more files or directories from the repository."-\end{code}--\options{remove}--\haskell{remove_help}+remove_description = "Remove files from version control." -\begin{code} remove_help :: String remove_help =- "Remove should be called when you want to remove a file from your project,\n"++- "but don't actually want to delete the file.  Otherwise just delete the\n"++- "file or directory, and darcs will notice that it has been removed.\n" ++- "Be aware that the file WILL be deleted from any other copy of the\n" ++- "repository to which you later apply the patch.\n"+ "The `darcs remove' command exists primarily for symmetry with `darcs\n" +++ "add', as the normal way to remove a file from version control is\n" +++ "simply to delete it from the working tree.  This command is only\n" +++ "useful in the unusual case where one wants to record a removal patch\n" +++ "WITHOUT deleting the copy in the working tree (which can be re-added).\n" +++ "\n" +++ "Note that applying a removal patch to a repository (e.g. by pulling\n" +++ "the patch) will ALWAYS affect the working tree of that repository.\n"  remove :: DarcsCommand remove = DarcsCommand {command_name = "remove",@@ -75,14 +74,17 @@ remove_cmd opts relargs =     withRepoLock opts $- \repository -> do     args <- fixSubPaths opts relargs+    when (null args) $+      putStrLn "Nothing specified, nothing removed."     p <- make_remove_patch repository args+    invalidateIndex repository     add_to_pending repository p  make_remove_patch :: RepoPatch p => Repository p -> [SubPath] -> IO (FL Prim) make_remove_patch repository files =                           do s <- slurp_pending repository                              srecorded <- slurp_recorded repository-                             pend <- get_unrecorded repository+                             pend <- get_unrecorded_in_files repository (map sp2fn files)                              let sunrec = fromJust $ apply_to_slurpy pend srecorded                              wt <- filetype_function                              mrp wt s sunrec files@@ -107,29 +109,21 @@             where fn = sp2fn f                   f_fp = toFilePath f           mrp _ _ _ [] = return NilFL-\end{code} -% rm - Note: not a subsection because not to be documented.--\begin{code} rm_description :: String-rm_description =- "Does not actually do anything, but offers advice on removing files"+rm_description = "Help newbies find `darcs remove'."  rm_help :: String rm_help =- "This command does not do anything.\n"++- "If you want to remove a file AND delete it, just delete the file or directory,\n"++- "and darcs will notice that it has been removed.\n" ++- "If you want to remove a file WITHOUT deleting it, use the 'remove' command\n"+ "The `darcs rm' command does nothing.\n" +++ "\n" +++ "The normal way to remove a file from version control is simply to\n" +++ "delete it from the working tree.  To remove a file from version\n" +++ "control WITHOUT affecting the working tree, see `darcs remove'.\n"  rm :: DarcsCommand rm = command_stub "rm" rm_help rm_description remove-\end{code} -% unadd - Note: not a subsection because not to be documented.--\begin{code} unadd :: DarcsCommand unadd = command_alias "unadd" remove \end{code}
src/Darcs/Commands/Repair.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs repair}+\darcsCommand{repair} \begin{code} module Darcs.Commands.Repair ( repair ) where import System.IO@@ -28,16 +28,10 @@                           replacePristineFromSlurpy, writePatchSet ) import Darcs.Repository.Repair( replayRepository,                                 RepositoryConsistency(..) )-\end{code} -\options{repair}-\begin{code} repair_description :: String repair_description = "Repair a corrupted repository."-\end{code}-\haskell{repair_help} -\begin{code} repair_help :: String repair_help =  "The `darcs repair' command attempts to fix corruption in the current\n" ++
src/Darcs/Commands/Replace.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs replace}+\darcsCommand{replace} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -50,51 +50,72 @@ #include "impossible.h"  replace_description :: String-replace_description =- "Replace a token with a new value for that token."-\end{code}--\options{replace}--\haskell{replace_help}--The default regexp is \verb![A-Za-z_0-9]!), and if one of your tokens-contains a `\verb|-|' or `\verb|.|', you will then (by default) get the ``filename''-regexp, which is \verb![A-Za-z_0-9\-\.]!.--\begin{options}---token-chars-\end{options}--If you prefer to choose a different set of characters to define your token-(perhaps because you are programming in some other language), you may do so-with the \verb!--token-chars! option.  You may prefer to define tokens in terms-of delimiting characters instead of allowed characters using a flag such as-\verb!--token-chars '[^ \n\t]'!, which would define a token as being-white-space delimited.--If you do choose a non-default token definition, I recommend using-\verb!_darcs/prefs/defaults! to always specify the same-\verb!--token-chars!, since your replace patches will be better behaved (in-terms of commutation and merges) if they have tokens defined in the same-way.+replace_description = "Substitute one word for another." -When using darcs replace, the ``new'' token may not already appear in the-file---if that is the case, the replace change would not be invertible.-This limitation holds only on the already-recorded version of the file.+replace_help :: String+replace_help =+ "In addition to line-based patches, Darcs supports a limited form of\n" +++ "lexical substitution.  Files are treated as sequences of words, and\n" +++ "each occurrence of the old word is replaced by the new word.\n" +++ "This is intended to provide a clean way to rename a function or\n" +++ "variable.  Such renamings typically affect lines all through the\n" +++ "source code, so a traditional line-based patch would be very likely to\n" +++ "conflict with other branches, requiring manual merging.\n" +++ "\n" +++ "Files are tokenized according to one simple rule: words are strings of\n" +++ "valid token characters, and everything between them (punctuation and\n" +++ "whitespace) is discarded.\n" +++ "\n" +++ "The tokenizer treats files as byte strings, so it is not possible for\n" +++ "--token-chars to include multi-byte characters, such as the non-ASCII\n" +++ "parts of UTF-8.  Similarly, trying to replace a `high-bit' character\n" +++ "from a unibyte encoding will also result in replacement of the same\n" +++ "byte in files with different encodings.  For example, an acute a from\n" +++ "ISO 8859-1 will also match an alpha from ISO 8859-7.\n" +++ "\n" +++ -- FIXME: this heuristic is ham-fisted and silly.  Can we drop it?+ "By default, valid token characters are letters, numbers and the\n" +++ "underscore (i.e. [A-Za-z0-9_]).  However if the old and/or new token\n" +++ "contains either a hyphen or period, BOTH hyphen and period are treated\n" +++ "as valid by default (i.e. [A-Za-z0-9_.-]).\n" +++ "\n" +++ "The set of valid characters can be customized using the --token-chars\n" +++ "option.  The argument must be surrounded by square brackets.  If a\n" +++ "hyphen occurs between two characters in the set, it is treated as a\n" +++ "set range.  For example, in most locales [A-Z] denotes all uppercase\n" +++ "letters.  If the first character is a caret, valid tokens are taken to\n" +++ "be the complement of the remaining characters.  For example, [^ \\n\\t]\n" +++ "declares all characters except the space, tab and newline as valid\n" +++ "within a word.  Unlike the tr(1) and grep(1) utilities, character\n" +++ "classes (such as [[:alnum:]]) are NOT supported.\n" +++ "\n" +++ "If you choose to use --token-chars, you are STRONGLY encouraged to do\n" +++ "so consistently.  The consequences of using multiple replace patches\n" +++ "with different --token-chars arguments on the same file are not well\n" +++ "tested nor well understood.\n" +++ "\n" +++ "By default Darcs will refuse to perform a replacement if the new token\n" +++ "is already in use, because the replacements would be not be\n" +++ "distinguishable from the existing tokens.  This behaviour can be\n" +++ "overridden by supplying the --force option, but an attempt to `darcs\n" +++ "rollback' the resulting patch will affect these existing tokens.\n" +-- FIXME: can  we just  delete the remaining  text?  It seems  more an+-- instance of "look how clever  I am; I made commutation work" rather+-- than information that is actually useful to users.+\end{code} There is a potentially confusing difference, however, when a replace is used to make another replace possible: \begin{verbatim}-% darcs replace newtoken aaack ./foo.c-% darcs replace oldtoken newtoken ./foo.c-% darcs record+$ darcs replace newtoken aaack ./foo.c+$ darcs replace oldtoken newtoken ./foo.c+$ darcs record \end{verbatim} will be valid, even if \verb!newtoken! and \verb!oldtoken! are both present in the recorded version of foo.c, while the sequence \begin{verbatim}-% [manually edit foo.c replacing newtoken with aaack]-% darcs replace oldtoken newtoken ./foo.c+$ [manually edit foo.c replacing newtoken with aaack]+$ darcs replace oldtoken newtoken ./foo.c \end{verbatim} will fail because ``newtoken'' still exists in the recorded version of \verb!foo.c!.  The reason for the difference is that when recording, a@@ -103,15 +124,7 @@ occurrences of the ``newtoken'' in your manual changes.  In contrast, multiple ``replace'' changes are recorded in the order in which they were made.- \begin{code}-replace_help :: String-replace_help =- "Replace allows you to change a specified token wherever it\n"++- "occurs in the specified files.  The replace is encoded in a\n"++- "special patch and will merge as expected with other patches.\n"++- "Tokens here are defined by a regexp specifying the characters\n"++- "which are allowed.  By default a token corresponds to a C identifier.\n"  replace :: DarcsCommand replace = DarcsCommand {command_name = "replace",@@ -176,23 +189,40 @@ default_toks = "A-Za-z_0-9" filename_toks :: String filename_toks = "A-Za-z_0-9\\-\\."++-- | Given a set of characters and a string, returns true iff the+-- string contains only characters from the set.  A set beginning with+-- a caret (@^@) is treated as a complementary set. is_tok :: String -> String -> Bool is_tok _ "" = False is_tok toks s = and $ map (regChars toks) s +-- | This function checks for @--token-chars@ on the command-line.  If+-- found, it validates the argument and returns it, without the+-- surrounding square brackets.  Otherwise, it returns either+-- 'default_toks' or 'filename_toks' as explained in 'replace_help'.+-- +-- Note: Limitations in the current replace patch file format prevents+-- tokens and token-char specifiers from containing any whitespace. choose_toks :: [DarcsFlag] -> String -> String -> IO String choose_toks (Toks t:_) a b-    | any isSpace t = fail $ bad_token_spec $ "Space is not allowed in the spec"-    | length t <= 2 = fail $ bad_token_spec $-                        "It must contain more than 2 characters, because " ++-                        "it should be enclosed in square brackets"-    | head t /= '[' || last t /= ']' = fail $ bad_token_spec $-                        "It should be enclosed in square brackets"-    | not (is_tok tok a) = fail $ bad_token_spec $ not_a_token a-    | not (is_tok tok b) = fail $ bad_token_spec $ not_a_token b+    | length t <= 2 =+        bad_token_spec $ "It must contain more than 2 characters, because " +++                         "it should be enclosed in square brackets"+    | head t /= '[' || last t /= ']' =+        bad_token_spec "It should be enclosed in square brackets"+    | '^' == head tok && length tok == 1 =+        bad_token_spec "Must be at least one character in the complementary set"+    | any isSpace t =+        bad_token_spec "Space is not allowed in the spec"+    | any isSpace a = bad_token_spec $ spacey_token a+    | any isSpace b = bad_token_spec $ spacey_token b+    | not (is_tok tok a) = bad_token_spec $ not_a_token a+    | not (is_tok tok b) = bad_token_spec $ not_a_token b     | otherwise          = return tok     where tok = init $ tail t :: String-          bad_token_spec msg = "Bad token spec: '"++ t ++"' ("++ msg ++")"+          bad_token_spec msg = fail $ "Bad token spec: '"++ t ++"' ("++ msg ++")"+          spacey_token x = x ++ " must not contain any space"           not_a_token x = x ++ " is not a token, according to your spec" choose_toks (_:fs) a b = choose_toks fs a b choose_toks [] a b = if is_tok default_toks a && is_tok default_toks b
src/Darcs/Commands/Revert.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs revert}+\darcsCommand{revert} \begin{code} module Darcs.Commands.Revert ( revert ) where import System.Exit ( ExitCode(..), exitWith )@@ -31,12 +31,13 @@                         list_registered_files, umask_option,                       ) import Darcs.Utils ( askUser )-import Darcs.RepoPath ( toFilePath )+import Darcs.RepoPath ( toFilePath, sp2fn ) import Darcs.Repository ( withRepoLock, ($-), withGutsOf,-                    get_unrecorded, get_unrecorded_unsorted,+                    get_unrecorded_in_files,+                    get_unrecorded_in_files_unsorted,                     add_to_pending, sync_repo,                     applyToWorking,-                    amInRepository, slurp_recorded_and_unrecorded,+                    amInRepository, slurp_recorded,                   ) import Darcs.Patch ( invert, apply_to_filepaths, commute ) import Darcs.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) )@@ -44,25 +45,24 @@ import Darcs.Patch.TouchesFiles ( choose_touching ) import Darcs.Commands.Unrevert ( write_unrevert ) import Darcs.Sealed ( unsafeUnseal )+import Darcs.Gorsvet( invalidateIndex )  revert_description :: String-revert_description =- "Revert to the recorded version (not always reversible)."-\end{code}--\options{revert}--\haskell{revert_help} The actions of a revert may be reversed using the-unrevert command (see subsection~\ref{unrevert}).  However, if you've made-changes since the revert your mileage may vary, so please be careful.+revert_description = "Discard unrecorded changes." -\begin{code} revert_help :: String revert_help =- "Revert is used to undo changes made to the working copy which have\n"++- "not yet been recorded.  You will be prompted for which changes you\n"++- "wish to undo. The last revert can be undone safely using the unrevert\n"++- "command if the working copy was not modified in the meantime.\n"+ "The `darcs revert' command discards unrecorded changes the working\n" +++ "tree.  As with `darcs record', you will be asked which hunks (changes)\n" +++ "to revert.  The --all switch can be used to avoid such prompting. If\n" +++ "files or directories are specified, other parts of the working tree\n" +++ "are not reverted.\n" +++ "\n" +++ "In you accidentally reverted something you wanted to keep (for\n" +++ "example, typing `darcs rev -a' instead of `darcs rec -a'), you can\n" +++ "immediately run `darcs unrevert' to restore it.  This is only\n" +++ "guaranteed to work if the repository has not changed since `darcs\n" +++ "revert' ran.\n"  revert :: DarcsCommand revert = DarcsCommand {command_name = "revert",@@ -77,24 +77,21 @@                        command_advanced_options = [ignoretimes, umask_option],                        command_basic_options = [all_interactive,                                                working_repo_dir]}-\end{code}-You can give revert optional arguments indicating files or directories.  If-you do so it will only prompt you to revert changes in those files or in-files in those directories.-\begin{code}+ revert_cmd :: [DarcsFlag] -> [String] -> IO () revert_cmd opts args = withRepoLock opts $- \repository -> do   files <- sort `fmap` fixSubPaths opts args+  let files_fn = map sp2fn files   when (areFileArgs files) $        putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n"   changes <- if All `elem` opts-                   then get_unrecorded_unsorted repository-                   else get_unrecorded repository+                   then get_unrecorded_in_files_unsorted repository files_fn+                   else get_unrecorded_in_files repository files_fn   let pre_changed_files = apply_to_filepaths (invert changes) (map toFilePath files)-  (rec, working_dir) <- slurp_recorded_and_unrecorded repository+  rec <- slurp_recorded repository   case unsafeUnseal $ choose_touching pre_changed_files changes of     NilFL -> putStrLn "There are no changes to revert!"-    _ -> with_selected_last_changes_to_files' "revert" opts working_dir+    _ -> with_selected_last_changes_to_files' "revert" opts                pre_changed_files changes $ \ (norevert:>p) ->         if nullFL p         then putStrLn $ "If you don't want to revert after all," ++@@ -107,6 +104,7 @@              case yorn of ('y':_) -> return ()                           _ -> exitWith $ ExitSuccess              withGutsOf repository $ do+                 invalidateIndex repository                  add_to_pending repository $ invert p                  when (Debug `elem` opts) $ putStrLn "About to write the unrevert file."                  case commute (norevert:>p) of
src/Darcs/Commands/Rollback.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs rollback}+\darcsCommand{rollback} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -38,10 +38,11 @@                        ) import Darcs.RepoPath ( toFilePath ) import Darcs.Repository ( amInRepository, withRepoLock, ($-), applyToWorking,-                          slurp_recorded_and_unrecorded, read_repo, slurp_recorded,+                          read_repo, slurp_recorded,                           tentativelyMergePatches, withGutsOf,                           finalizeRepositoryChanges, sync_repo )-import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims, sort_coalesceFL )+import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims,+                     sort_coalesceFL, canonize ) import Darcs.Ordered import Darcs.Hopefully ( n2pia ) import Darcs.Lock ( world_readable_temp )@@ -52,9 +53,11 @@ import Darcs.Commands.Record ( file_exists, get_log ) import Darcs.Commands.Unrecord ( get_last_patches ) import Darcs.Utils ( clarify_errors )+import Printer ( renderString ) import Progress ( debugMessage ) import Darcs.Sealed ( Sealed(..), FlippedSeal(..) ) import IsoDate ( getIsoDateTime )+import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h"  rollback_description :: String@@ -62,9 +65,7 @@  "Record a new patch reversing some recorded changes." \end{code} -\options{rollback}--\haskell{rollback_help} If you decide you didn't want to roll back a patch+If you decide you didn't want to roll back a patch after all, you can reverse its effect by obliterating the rolled-back patch.  Rollback can actually allow you to roll back a subset of the changes made@@ -112,23 +113,23 @@        logMessage $ "Non existent files or directories: "++unwords non_existent_files++"\n"   when ((not $ null non_existent_files) && null existing_files) $        fail "None of the files you specified exist!"-  (recorded, working_dir) <- slurp_recorded_and_unrecorded repository   allpatches <- read_repo repository   FlippedSeal patches <- return $ if first_match opts                                   then get_last_patches opts allpatches                                   else FlippedSeal $ concatRL allpatches-  with_selected_last_changes_to_files_reversed "rollback" opts recorded existing_files+  with_selected_last_changes_to_files_reversed "rollback" opts existing_files       (reverseRL patches) $     \ (_ :> ps) ->     do when (nullFL ps) $ do logMessage "No patches selected!"                              exitWith ExitSuccess        definePatches ps-       with_selected_last_changes_to_files' "rollback" opts working_dir-               existing_files (sort_coalesceFL $ effect ps) $ \ (_:>ps'') ->+       with_selected_last_changes_to_files' "rollback" opts+               existing_files (concatFL $ mapFL_FL canonize $+                               sort_coalesceFL $ effect ps) $ \ (_:>ps'') ->          do when (nullFL ps'') $ do logMessage "No changes selected!"                                     exitWith ExitSuccess             let make_log = world_readable_temp "darcs-rollback"-                newlog = Just ("", "":"rolling back:":"":lines (show $ summary ps ))+                newlog = Just ("", "":"rolling back:":"":lines (renderString $ summary ps ))             --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)             (name, my_log, logf) <- get_log opts newlog make_log $ invert ps''             date <- getIsoDateTime@@ -139,6 +140,7 @@             Sealed pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts)                          NilFL (rbp :>: NilFL)             debugMessage "Finalizing rollback changes..."+            invalidateIndex repository             withGutsOf repository $ do               finalizeRepositoryChanges repository               debugMessage "About to apply rolled-back changes to working directory."
src/Darcs/Commands/Send.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs send}+\darcsCommand{send} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -25,10 +25,9 @@ import System.Exit ( exitWith, ExitCode( ExitSuccess ) ) import System.IO.Error ( ioeGetErrorString ) import System.IO ( hClose )-import Control.Monad ( when, unless )+import Control.Monad ( when, unless, forM_ ) import Data.Maybe ( isJust, isNothing ) -import Autoconf ( have_HTTP ) import Darcs.Commands ( DarcsCommand(..) ) import Darcs.Arguments ( DarcsFlag( EditDescription, LogFile, RmLogFile,                                     Target, OutputAutoName, Output, Context,@@ -74,12 +73,7 @@ send_description :: String send_description =  "Send by email a bundle of one or more patches."-\end{code} -\options{send}--\haskell{send_help}-\begin{code} send_help :: String send_help =  "Send is used to prepare a bundle of patches that can be applied to a target\n"++@@ -186,7 +180,7 @@                         $$ (vcat $ mapRL description $ head $ unsafeUnRL us')      s <- slurp_recorded repo      let our_ps = reverseRL $ head $ unsafeUnRL us'-     with_selected_changes "send" opts s our_ps $+     with_selected_changes "send" opts our_ps $       \ (to_be_sent :> _) -> do       print_dry_run_message_and_exit "send" opts to_be_sent       when (nullFL to_be_sent) $ do@@ -236,8 +230,9 @@                             ++ lt [ t | SendMail t <- thetargets ]                             ++ ccs (get_cc opts) ++"."))                  `catch` \e -> let msg = "Email body left in " in-                               do when (isJust mailfile) $-                                       putStrLn $ msg++(fromJust mailfile)++"."+                               do case mailfile of+                                    Just mf -> putStrLn $ msg++mf++"."+                                    Nothing -> return ()                                   fail $ ioeGetErrorString e                ccs [] = []                ccs cs  = " and cc'ed " ++ cs@@ -317,9 +312,6 @@  \begin{code} -forM_ :: (Monad m) => [a] -> (a -> m b) -> m ()-forM_ = (flip mapM_)- data WhatToDo     = Post String        -- ^ POST the patch via HTTP     | SendMail String    -- ^ send patch via email@@ -338,13 +330,21 @@     ts -> do announce_recipients ts              return ts     where the_targets = collect_targets opts-          check_post | have_HTTP =-                         do p <- ((readPost . BC.unpack) `fmap`-                                  fetchFilePS (prefsUrl the_remote_repo++"/post")-                                  (MaxAge 600)) `catchall` return []-                            emails <- who_to_email-                            return (p++emails)-                     | otherwise = who_to_email+#ifdef HAVE_HTTP+          -- the ifdef above is to so that darcs only checks the remote+          -- _darcs/post if we have an implementation of postUrl.  See+          -- our HTTP module for more details+          check_post = do p <- ((readPost . BC.unpack) `fmap`+                                fetchFilePS (prefsUrl the_remote_repo++"/post")+                                (MaxAge 600)) `catchall` return []+                          emails <- who_to_email+                          return (p++emails)+          readPost p = map pp (lines p) where+            pp ('m':'a':'i':'l':'t':'o':':':s) = SendMail s+            pp s = Post s+#else+          check_post = who_to_email+#endif           who_to_email =               do email <- (BC.unpack `fmap`                            fetchFilePS (prefsUrl the_remote_repo++"/email")@@ -352,9 +352,6 @@                           `catchall` return ""                  if '@' `elem` email then return . map SendMail $ lines email                                      else return []-          readPost p = map pp (lines p) where-            pp ('m':'a':'i':'l':'t':'o':':':s) = SendMail s-            pp s = Post s           putInfoLn s = unless (Quiet `elem` opts) $ putStrLn s           announce_recipients emails =             let pn (SendMail s) = s
src/Darcs/Commands/SetPref.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs setpref}+\darcsCommand{setpref} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -31,6 +31,7 @@ import Darcs.Patch ( changepref ) import Darcs.Ordered ( FL(..) ) import Darcs.Repository.Prefs ( get_prefval, change_prefval, )+import English ( orClauses ) #include "impossible.h"  -- | A list of all valid preferences for @_darcs/prefs/prefs@.@@ -43,18 +44,10 @@  valid_prefs :: [String] valid_prefs = map fst valid_pref_data-\end{code} -\options{setpref}-\haskell{setpref_description}-\begin{code} setpref_description :: String-setpref_description = "Set the value of a preference (" ++ ps ++ ")."-    where ps = iter valid_prefs-          iter [x] = x-          iter [x,y] = x ++ " or " ++ y-          iter (x:xs) = x ++ ", " ++ (iter xs)-          iter [] = ""           -- impossible, but keeps -Wall happy+setpref_description =+    "Set a preference (" ++ orClauses valid_prefs ++ ")."  setpref_help :: String setpref_help =@@ -66,7 +59,7 @@  "\n" ++  "Valid preferences are:\n" ++  "\n" ++- (unlines $ map unwords $ map (\ (x,y) -> [" ",x,"--",y]) valid_pref_data) +++ unlines ["  "++x++" -- "++y | (x,y) <- valid_pref_data] ++  "\n" ++  "For example, a project using GNU autotools, with a `make test' target\n" ++  "to perform regression tests, might enable Darcs' integrated regression\n" ++
src/Darcs/Commands/Show.lhs view
@@ -28,6 +28,7 @@ import Darcs.Commands.ShowFiles ( show_files, show_manifest ) import Darcs.Commands.ShowTags ( show_tags ) import Darcs.Commands.ShowRepo ( show_repo )+import Darcs.Commands.ShowIndex ( show_index, show_pristine ) import Darcs.Repository ( amInRepository )  show_description :: String@@ -36,7 +37,10 @@ show_help :: String show_help =  "Use the --help option with the subcommands to obtain help for\n"++- "subcommands (for example, \"darcs show files --help\").\n"+ "subcommands (for example, \"darcs show files --help\").\n" +++ "\n" +++ "In previous releases, this command was called `darcs query'.\n" +++ "Currently this is a deprecated alias.\n"  show_command :: DarcsCommand show_command = SuperCommand {command_name = "show",@@ -46,6 +50,8 @@                       command_sub_commands = [Hidden_command show_bug,                                               Command_data show_contents,                                               Command_data show_files, Hidden_command show_manifest,+                                              Command_data show_index,+                                              Command_data show_pristine,                                               Command_data show_repo,                                               Command_data show_authors,                                               Command_data show_tags]
src/Darcs/Commands/ShowAuthors.lhs view
@@ -1,4 +1,4 @@-%  Copyright (C) 2008 Eric Kow+%  Copyright (C) 2004-2009 David Roundy, Eric Kow, Simon Michael % %  This program is free software; you can redistribute it and/or modify %  it under the terms of the GNU General Public License as published by@@ -15,11 +15,16 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsubsection{darcs show authors}+\darcsCommand{show authors} \begin{code}+{-# OPTIONS_GHC -cpp #-} module Darcs.Commands.ShowAuthors ( show_authors ) where -import Data.List ( sort, group )+import Control.Arrow ((&&&), (***))+import Data.List ( sort, sortBy, group, groupBy, isInfixOf, isPrefixOf )+import Data.Ord (comparing)+import Data.Char ( toLower, isSpace )+import Text.Regex ( Regex, mkRegexWithOpts, matchRegex )  import Darcs.Arguments ( DarcsFlag(..), working_repo_dir ) import Darcs.Commands ( DarcsCommand(..), nodefaults )@@ -29,20 +34,40 @@ import Darcs.Patch.Info ( pi_author ) import Darcs.Ordered ( mapRL, concatRL ) import Printer ( text )-\end{code}--\options{show authors}--\haskell{show_authors_help}+import Data.Function (on) -\begin{code} show_authors_description :: String-show_authors_description = "Show all authors in the repository."+show_authors_description = "List authors by patch count."  show_authors_help :: String show_authors_help =- "The authors command writes a list of all patch authors in the repository to\n" ++- "standard output."+ "The `darcs show authors' command lists the authors of the current\n" +++ "repository, sorted by the number of patches contributed.  With the\n" +++ "--verbose option, this command simply lists the author of each patch\n" +++ "(without aggregation or sorting).\n" +++ "\n" +++ "An author's name or email address may change over time.  To tell Darcs\n" +++ "when multiple author strings refer to the same individual, create an\n" +++ "`.authorspellings' file in the root of the working tree.  Each line in\n" +++ "this file begins with an author's canonical name and address, and may\n" +++ "be followed by a comma and zero or more extended regular expressions,\n" +++ "separated by commas.  Blank lines and lines beginning with two\n" +++ "hyphens, are ignored.\n" +++ "\n" +++ "Any patch with an author string that matches the canonical address or\n" +++ "any of the associated regexps is considered to be the work of that\n" +++ "author.  All matching is case-insensitive and partial (it can match a\n" +++ "substring).\n" +++ "\n" +++ "Currently this canonicalization step is done only in `darcs show\n" +++ "authors'.  Other commands, such as `darcs changes' use author strings\n" +++ "verbatim.\n" +++ "\n" +++ "An example .authorspelling file is:\n" +++ "\n" +++ "    -- This is a comment.\n" +++ "    Fred Nurk <fred@example.com>\n" +++ "    John Snagge <snagge@bbc.co.uk>, John, snagge@, js@(si|mit).edu\n"  show_authors :: DarcsCommand show_authors = DarcsCommand {@@ -61,13 +86,75 @@ authors_cmd :: [DarcsFlag] -> [String] -> IO () authors_cmd opts _ = withRepository opts $- \repository -> do   patches <- read_repo repository-  let authors = mapRL process $ concatRL patches+  spellings <- compiled_author_spellings+  let authors = mapRL (pi_author . info) $ concatRL patches   viewDoc $ text $ unlines $    if Verbose `elem` opts-      then authors-      else reverse $ map shownames $ sort $-           map (\s -> (length s,head s)) $ group $ sort authors-  where-    process =  pi_author . info-    shownames (n, a) = show n ++ "\t" ++ a+    then authors+    else -- A list of the form ["<count> <canonical name>"]...++      -- Turn the final result into a list of strings.+      map (\ (count, name) -> show count ++ "\t" ++ name) $+      -- Sort by descending patch count.+      reverse $ sortBy (comparing fst) $+      -- Combine duplicates from a list [(count, canonized name)]+      -- with duplicates canonized names (see next comment).+      map ((sum *** head) . unzip) $+      groupBy ((==) `on` snd) $+      sortBy  (comparing snd) $+      -- Because it would take a long time to canonize "foo" into+      -- "foo <foo@bar.baz>" once per patch, the code below+      -- generates a list [(count, canonized name)].+      map (length &&& (canonize_author spellings . head)) $+      group $ sort authors++canonize_author :: [(String,[Regex])] -> String -> String+canonize_author [] a = a+canonize_author spellings a = safehead a $ canonicalsfor a+    where+      safehead x xs = if null xs then x else head xs+      canonicalsfor s = map fst $ filter (ismatch s) spellings+      ismatch s (canonical,regexps) =+          (not (null email) && (s `contains` email)) || (any (s `contains_regex`) regexps)+          where email = takeWhile (/= '>') $ drop 1 $ dropWhile (/= '<') canonical++contains :: String -> String -> Bool+a `contains` b = lower b `isInfixOf` (lower a) where lower = map toLower++contains_regex :: String -> Regex -> Bool+a `contains_regex` r = case matchRegex r a of+                         Just _ -> True+                         _ -> False++compiled_author_spellings :: IO [(String,[Regex])]+compiled_author_spellings = do+  ss <- author_spellings_from_file+  return $ map compile $ ss+    where+      compile [] = error "each author spelling should contain at least the canonical form"+      compile (canonical:pats) = (canonical, map mkregex pats)+      mkregex pat = mkRegexWithOpts pat True False++authorspellingsfile :: FilePath+authorspellingsfile = ".authorspellings"++author_spellings_from_file :: IO [[String]]+author_spellings_from_file = do+  s <- readFile -- ratify readFile: never unlinked from within darcs+         authorspellingsfile `catch` (\_ -> return "")+  let noncomments = filter (not . ("--" `isPrefixOf`)) $+                    filter (not . null) $ map strip $ lines s+  return $ map (map strip . split_on ',') noncomments++split_on :: Eq a => a -> [a] -> [[a]]+split_on e l =+    case dropWhile (e==) l of+      [] -> []+      l' -> first : split_on e rest+        where+          (first,rest) = break (e==) l'++strip :: String -> String+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse+ \end{code}
src/Darcs/Commands/ShowBug.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs show bug}+\darcsCommand{show bug} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -26,15 +26,10 @@ import Darcs.Arguments ( DarcsFlag, working_repo_dir ) import Darcs.Repository ( findRepository ) #include "impossible.h"-\end{code} -\options{show bug}-\begin{code} show_bug_description :: String-show_bug_description = "Pretends to be a bug in darcs."-\end{code}-\haskell{show_bug_help}-\begin{code}+show_bug_description = "Simulate a run-time failure."+ show_bug_help :: String show_bug_help =   "Show bug can be used to see what darcs would show you if you encountered.\n"
src/Darcs/Commands/ShowContents.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsubsection{darcs show contents}+\darcsCommand{show contents} \begin{code} module Darcs.Commands.ShowContents ( show_contents ) where @@ -35,15 +35,10 @@ import Darcs.Repository ( withRepository, ($-), findRepository,                           createPartialsPristineDirectoryTree ) import Darcs.Lock ( withTempDir )-\end{code} -\options{show contents}-\begin{code} show_contents_description :: String show_contents_description = "Outputs a specific version of a file."-\end{code}-\haskell{show_contents_help}-\begin{code}+ show_contents_help :: String show_contents_help =   "Show contents can be used to display an earlier version of some file(s).\n"++
src/Darcs/Commands/ShowFiles.lhs view
@@ -15,8 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsubsection{darcs show files}-\label{show-files}+\darcsCommand{show files} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -29,38 +28,34 @@                           withRepository ) import Darcs.Patch ( RepoPatch ) import Darcs.SlurpDirectory ( Slurpy, list_slurpy, list_slurpy_files, list_slurpy_dirs )-\end{code} -\options{show files}--\haskell{show_files_help}--By default (and if the \verb!--pending! option is specified),-the effect of pending patches on the repository is taken into account.-In other words, if you add a file using {\tt darcs add}, it-immediately appears in the output of {\tt query manifest}, even if it-is not yet recorded.  If you specify the \verb!--no-pending! option,-{\tt query manifest} will only list recorded files (and directories).--The \verb!--files! and \verb!--directories! options control whether-files and directories are included in the output.  The-\verb!--no-files!  and \verb!--no-directories! options have the-reverse effect.  The default is to include files, but not directories.--If you specify the \verb!--null! option, the file names are written to-standard output in unescaped form, and separated by ASCII NUL bytes.-This format is suitable for further automatic processing (for example,-using \verb!xargs -0!).--\begin{code} show_files_description :: String show_files_description = "Show version-controlled files in the working copy."  show_files_help :: String show_files_help =- "The files command lists the version-controlled files in the\n"++- "working copy.  The similar manifest command, lists the same\n"++- "files, excluding any directories.\n"+ "The `darcs show files' command lists those files and directories in\n" +++ "the working tree that are under version control.  This command is\n" +++ "primarily for scripting purposes; end users will probably want `darcs\n" +++ "whatsnew --summary'.\n" +++ "\n" +++ "A file is `pending' if it has been added but not recorded.  By\n" +++ "default, pending files (and directories) are listed; the --no-pending\n" +++ "option prevents this.\n" +++ "\n" +++ "By default `darcs show files' lists both files and directories, but\n" +++ "the alias `darcs show manifest' only lists files.  The --files,\n" +++ "--directories, --no-files and --no-directories modify this behaviour.\n" +++ "\n" +++ "By default entries are one-per-line (i.e. newline separated).  This\n" +++ "can cause problems if the files themselves contain newlines or other\n" +++ "control characters.  To get aroudn this, the --null option uses the\n" +++ "null character instead.  The script interpreting output from this\n" +++ "command needs to understand this idiom; `xargs -0' is such a command.\n" +++ "\n" +++ "For example, to list version-controlled files by size:\n" +++ "\n" +++ "    darcs show files -0 | xargs -0 ls -ldS\n"  show_files :: DarcsCommand show_files = DarcsCommand {
+ src/Darcs/Commands/ShowIndex.lhs view
@@ -0,0 +1,94 @@+% Copyright (C) 2009 Petr Rockai+%+% Permission is hereby granted, free of charge, to any person+% obtaining a copy of this software and associated documentation+% files (the "Software"), to deal in the Software without+% restriction, including without limitation the rights to use, copy,+% modify, merge, publish, distribute, sublicense, and/or sell copies+% of the Software, and to permit persons to whom the Software is+% furnished to do so, subject to the following conditions:+%+% The above copyright notice and this permission notice shall be+% included in all copies or substantial portions of the Software.+%+% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+% SOFTWARE.++\darcsCommand{show index}+\begin{code}+{-# OPTIONS_GHC -cpp #-}+{-# LANGUAGE CPP #-}+#include "gadts.h"+module Darcs.Commands.ShowIndex ( show_index, show_pristine ) where+import Darcs.Arguments ( DarcsFlag(..), working_repo_dir,+                        files, directories, nullFlag )+import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias )+import Darcs.Repository ( amInRepository, withRepository, ($-) )++import Darcs.Gorsvet( readIndex )+import Storage.Hashed( readDarcsPristine, floatPath )+import Storage.Hashed.Darcs( darcsFormatHash )+import Storage.Hashed.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )+import Storage.Hashed.AnchoredPath( anchorPath )++import qualified Data.ByteString.Char8 as BS++show_index :: DarcsCommand+show_index = DarcsCommand {+  command_name = "index",+  command_description = "Dump contents of working tree index.",+  command_help =+      "The `darcs show index' command lists all version-controlled files and " +++      "directories along with their hashes as stored in _darcs/index. " +++      "For files, the fields correspond to file size, sha256 of the current " +++      "file content and the filename.",+  command_extra_args = 0,+  command_extra_arg_help = [],+  command_command = show_index_cmd,+  command_prereq = amInRepository,+  command_get_arg_possibilities = return [],+  command_argdefaults = nodefaults,+  command_advanced_options = [],+  command_basic_options = [files, directories, nullFlag, working_repo_dir] }++show_pristine :: DarcsCommand+show_pristine = command_alias "pristine" show_index {+  command_command = show_pristine_cmd,+  command_description = "Dump contents of pristine cache.",+  command_help =+      "The `darcs show pristine' command lists all version-controlled files " +++      "and directories along with the hashes of their pristine copies. " +++      "For files, the fields correspond to file size, sha256 of the pristine " +++      "file content and the filename." }++dump :: [DarcsFlag] -> Tree -> IO ()+dump opts tree = do+  let line | NullFlag `elem` opts = \t -> putStr t >> putChar '\0'+           | otherwise = putStrLn+      output (p, i) = do+        let hash = case itemHash i of+                     Just h -> BS.unpack $ darcsFormatHash h+                     Nothing -> "(no hash available)"+            path = anchorPath "" p+            isdir = case i of+                      SubTree _ -> "/"+                      _ -> ""+        line $ hash ++ " " ++ path ++ isdir+  x <- expand tree+  mapM_ output $ (floatPath ".", SubTree x) : list x++show_index_cmd :: [DarcsFlag] -> [String] -> IO ()+show_index_cmd opts _ = withRepository opts $- \repo -> do+  readIndex repo >>= dump opts++show_pristine_cmd :: [DarcsFlag] -> [String] -> IO ()+show_pristine_cmd opts _ = withRepository opts $- \_ -> do+  readDarcsPristine "." >>= dump opts++\end{code}
src/Darcs/Commands/ShowRepo.lhs view
@@ -15,10 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsubsection{darcs show repo}-%%\label{show-repo}--\options{show repo}+\darcsCommand{show repo}  The \verb!show repo! displays information about the current repository: the location, the type, etc.@@ -48,7 +45,6 @@ import Darcs.Repository.Format ( RepoFormat(..) ) import Darcs.Repository.Prefs ( get_preflist ) import Darcs.Repository.Motd ( get_motd )-import Darcs.Global ( darcsdir ) import Darcs.Patch ( RepoPatch ) import Darcs.Ordered ( lengthRL, concatRL ) import qualified Data.ByteString.Char8 as BC  (unpack)@@ -57,7 +53,7 @@ show_repo_help =  "The repo command displays information about the current repository\n" ++  "(location, type, etc.).  Some of this information is already available\n" ++- "by inspecting files within the "++darcsdir++" directory and some is internal\n" +++ "by inspecting files within the _darcs directory and some is internal\n" ++  "information that is informational only (i.e. for developers).  This\n" ++  "command collects all of the repository information into a readily\n" ++  "available source.\n"
src/Darcs/Commands/ShowTags.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsubsection{darcs show tags}+\darcsCommand{show tags} \begin{code} module Darcs.Commands.ShowTags ( show_tags ) where import Darcs.Arguments ( DarcsFlag(..), working_repo_dir )@@ -26,24 +26,18 @@ import Darcs.Ordered ( mapRL, concatRL ) import System.IO ( stderr, hPutStrLn ) -- import Printer ( renderPS )-\end{code} -\options{show tags}--\haskell{show_tags_help}--Tab characters (ASCII character 9) in tag names are changed to spaces-for better interoperability with shell tools.  A warning is printed if-this happens.--\begin{code} show_tags_description :: String show_tags_description = "Show all tags in the repository."  show_tags_help :: String show_tags_help =  "The tags command writes a list of all tags in the repository to standard\n"++- "output."+ "output.\n" +++ "\n" +++ "Tab characters (ASCII character 9) in tag names are changed to spaces\n" +++ "for better interoperability with shell tools.  A warning is printed if\n" +++ "this happens."  show_tags :: DarcsCommand show_tags = DarcsCommand {
src/Darcs/Commands/Tag.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs tag}+\darcsCommand{tag} \begin{code} module Darcs.Commands.Tag ( tag ) where import Control.Monad ( when )@@ -42,12 +42,6 @@ import Darcs.Lock ( world_readable_temp ) import Darcs.Flags ( DarcsFlag(..) ) import System.IO ( hPutStr, stderr )--\end{code}-\haskell{tag_description}-\options{tag}-\haskell{tag_help}-\begin{code}  tag_description :: String tag_description = "Name the current repository state for future reference."
src/Darcs/Commands/TrackDown.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs trackdown}+\darcsCommand{trackdown} \begin{code} module Darcs.Commands.TrackDown ( trackdown ) where import Prelude hiding ( init )@@ -35,18 +35,10 @@ import Printer ( putDocLn ) import Darcs.Test ( get_test ) import Darcs.Lock ( withTempDir )-\end{code} -\options{trackdown}--\begin{code} trackdown_description :: String trackdown_description = "Locate the most recent version lacking an error."-\end{code} -\haskell{trackdown_help}--\begin{code} trackdown_help :: String trackdown_help =  "Trackdown tries to find the most recent version in the repository which\n"++
src/Darcs/Commands/TransferMode.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs changes}+\darcsCommand{transfer-mode} \begin{code} {-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, PatternGuards #-}@@ -35,15 +35,10 @@ import Darcs.Global ( darcsdir )  import qualified Data.ByteString as B (hPut, readFile, length, ByteString)-\end{code} -\options{transfer_mode}-\begin{code} transfer_mode_description :: String transfer_mode_description = "Internal command for efficient ssh transfers."-\end{code}-\haskell{transfer_mode_help}-\begin{code}+ transfer_mode_help :: String transfer_mode_help =  "When pulling from or pushing to a remote repository over ssh, if both\n" ++
src/Darcs/Commands/Unrecord.lhs view
@@ -15,8 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs unrecord}-\label{unrecord}+\darcsCommand{unrecord} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -32,11 +31,11 @@                          working_repo_dir, nocompress, definePatches,                         match_several_or_last, deps_sel,                         ignoretimes,-                        all_interactive, umask_option,+                        all_interactive, umask_option, summary                       ) import Darcs.Match ( first_match, match_first_patchset, match_a_patchread ) import Darcs.Repository ( PatchSet, PatchInfoAnd, withGutsOf,-                          withRepoLock, ($-), slurp_recorded,+                          withRepoLock, ($-),                     tentativelyRemovePatches, finalizeRepositoryChanges,                     tentativelyAddToPending,                     applyToWorking,@@ -51,6 +50,7 @@ import Darcs.SelectChanges ( with_selected_last_changes_reversed ) import Progress ( debugMessage ) import Darcs.Sealed ( Sealed(..), FlippedSeal(..), mapFlipped )+import Darcs.Gorsvet( invalidateIndex ) #include "gadts.h"  unrecord_description :: String@@ -58,10 +58,6 @@  "Remove recorded patches without changing the working copy." \end{code} -\options{unrecord}--\haskell{unrecord_help}- Unrecord can be thought of as undo-record. If a record is followed by an unrecord, everything looks like before the record; all the previously unrecorded changes are back, and can be@@ -156,12 +152,11 @@ unrecord_cmd :: [DarcsFlag] -> [String] -> IO () unrecord_cmd opts _ = withRepoLock opts $- \repository -> do   let (logMessage,_,_) = loggers opts-  recorded <- slurp_recorded repository   allpatches <- read_repo repository   FlippedSeal patches <- return $ if first_match opts                                   then get_last_patches opts allpatches                                   else matchingHead opts allpatches-  with_selected_last_changes_reversed "unrecord" opts recorded+  with_selected_last_changes_reversed "unrecord" opts       (reverseRL patches) $     \ (_ :> to_unrecord) -> do        when (nullFL to_unrecord) $ do logMessage "No patches selected!"@@ -169,6 +164,7 @@        when (Verbose `elem` opts) $             logMessage "About to write out (potentially) modified patches..."        definePatches to_unrecord+       invalidateIndex repository        withGutsOf repository $ do tentativelyRemovePatches repository opts $                                                            mapFL_FL hopefully to_unrecord                                   finalizeRepositoryChanges repository@@ -202,13 +198,11 @@  unpull_cmd :: [DarcsFlag] -> [String] -> IO () unpull_cmd = generic_obliterate_cmd "unpull"-\end{code} ---\subsection{darcs obliterate}-+\end{code}+\darcsCommand{obliterate} \begin{code}+ obliterate_description :: String obliterate_description =  "Delete selected patches from the repository. (UNSAFE!)"@@ -219,12 +213,8 @@  "The changes will be undone in your working copy and the patches will not be\n"++  "shown in your changes list anymore.\n"++  "Beware that you can lose precious code by obliterating!\n"-\end{code} -\options{obliterate}--\haskell{obliterate_help}-+\end{code} Obliterate deletes a patch from the repository \emph{and} removes those changes from the working directory.  It is therefore a \emph{very dangerous} command.  When there are no local changes, obliterate is@@ -283,20 +273,25 @@                            command_basic_options = [match_several_or_last,                                                    deps_sel,                                                    all_interactive,-                                                   working_repo_dir]}+                                                   working_repo_dir,+                                                   summary]} obliterate_cmd :: [DarcsFlag] -> [String] -> IO () obliterate_cmd = generic_obliterate_cmd "obliterate" -generic_obliterate_cmd :: String -> [DarcsFlag] -> [String] -> IO ()+-- | generic_obliterate_cmd is the function that executes the "obliterate" and+--   "unpull" commands.+generic_obliterate_cmd :: String      -- ^ The name under which the command is invoked (@unpull@ or @obliterate@)+                       -> [DarcsFlag] -- ^ The flags given on the command line+                       -> [String]    -- ^ Files given on the command line (unused)+                       -> IO () generic_obliterate_cmd cmdname opts _ = withRepoLock opts $- \repository -> do   let (logMessage,_,_) = loggers opts-  recorded <- slurp_recorded repository   pend <- get_unrecorded repository   allpatches <- read_repo repository   FlippedSeal patches <- return $ if first_match opts                                   then get_last_patches opts allpatches                                   else matchingHead opts allpatches-  with_selected_last_changes_reversed cmdname opts recorded+  with_selected_last_changes_reversed cmdname opts       (reverseRL patches) $     \ (_ :> ps) ->     case commutex (pend :< effect ps) of@@ -306,6 +301,7 @@         when (nullFL ps) $ do logMessage "No patches selected!"                               exitWith ExitSuccess         definePatches ps+        invalidateIndex repository         withGutsOf repository $                              do tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)                                 tentativelyAddToPending repository opts $ invert $ effect ps
src/Darcs/Commands/Unrevert.lhs view
@@ -15,7 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs unrevert}\label{unrevert}+\darcsCommand{unrevert} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -35,7 +35,7 @@                           tentativelyAddToPending, finalizeRepositoryChanges,                           sync_repo, get_unrecorded,                           read_repo, amInRepository,-                          slurp_recorded_and_unrecorded,+                          slurp_recorded,                           applyToWorking ) import Darcs.Patch ( RepoPatch, Prim, commutex, namepatch, fromPrims ) import Darcs.Ordered ( RL(..), FL(..), (:<)(..), (:>)(..), (:\/:)(..), reverseRL,@@ -56,21 +56,16 @@ unrevert_description :: String unrevert_description =  "Undo the last revert (may fail if changes after the revert)."-\end{code} -\options{unrevert}--\haskell{unrevert_help}-\begin{code} unrevert_help :: String unrevert_help =  "Unrevert is a rescue command in case you accidentally reverted\n" ++- "something you wanted to keep (for example, accidentally typing `darcs\n" ++- "rev -a' instead of `darcs rec -a').\n" +++ "something you wanted to keep (for example, typing `darcs rev -a'\n" +++ "instead of `darcs rec -a').\n" ++  "\n" ++  "This command may fail if the repository has changed since the revert\n" ++  "took place.  Darcs will ask for confirmation before executing an\n" ++- "interactive command that will *definitely* prevent unreversion.\n"+ "interactive command that will DEFINITELY prevent unreversion.\n"  unrevert :: DarcsCommand unrevert = DarcsCommand {command_name = "unrevert",@@ -91,13 +86,13 @@ unrevert_cmd opts [] = withRepoLock opts $- \repository -> do   us <- read_repo repository   Sealed them <- unrevert_patch_bundle repository-  (rec, working) <- slurp_recorded_and_unrecorded repository+  rec <- slurp_recorded repository   unrec <- get_unrecorded repository   case get_common_and_uncommon (us, them) of     (_, (h_us:<:NilRL) :\/: (h_them:<:NilRL)) -> do       Sealed pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts)                    (reverseRL h_us) (reverseRL h_them)-      with_selected_changes_to_files' "unrevert" opts working [] pw $+      with_selected_changes_to_files' "unrevert" opts [] pw $                             \ (p :> skipped) -> do         tentativelyAddToPending repository opts p         withSignalsBlocked $
src/Darcs/Commands/WhatsNew.lhs view
@@ -15,8 +15,7 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. -\subsection{darcs whatsnew}-\label{whatsnew}+\darcsCommand{whatsnew} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}@@ -25,42 +24,38 @@  module Darcs.Commands.WhatsNew ( whatsnew ) where import System.Exit ( ExitCode(..), exitWith )-import System.Directory ( doesFileExist, doesDirectoryExist ) import Data.List ( sort ) import Control.Monad ( when )  import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag(..), working_repo_dir, lookforadds,                         ignoretimes, noskip_boring,-                        unified, summary,+                        unified, summary, no_cache,                          areFileArgs, fixSubPaths,                         list_registered_files,                       )-import Darcs.Patch.FileName ( encode_white )-import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )+import Darcs.RepoPath ( SubPath, sp2fn )  import Darcs.Repository ( Repository, withRepository, ($-), slurp_recorded,                           get_unrecorded_no_look_for_adds,                           get_unrecorded_in_files, amInRepository )-import Darcs.Repository.Internal ( slurp_recorded_and_unrecorded ) import Darcs.Repository.Prefs ( filetype_function ) import Darcs.Diff ( unsafeDiff ) import Darcs.Patch ( RepoPatch, Prim, summarize, apply_to_slurpy, is_hunk ) import Darcs.Patch.Permutations ( partitionRL ) import Darcs.Patch.Real ( RealPatch, prim2real )+import Darcs.Patch.FileName ( fn2fp ) import Darcs.PrintPatch ( printPatch, contextualPrintPatch ) import Darcs.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL ) -import Darcs.SlurpDirectory( Slurpy, slurp_has )+import Darcs.Gorsvet( unrecordedChanges, restrictBoring, readRecordedAndPending )+import Storage.Hashed.Monad( virtualTreeIO, exists )+import Storage.Hashed( readPlainTree )+import Storage.Hashed( floatPath )  import Printer ( putDocLn, renderString, vcat, text ) #include "impossible.h"-\end{code} -\options{whatsnew}--\haskell{whatsnew_description}-\begin{code} whatsnew_description :: String whatsnew_description = "List unrecorded changes in the working tree." @@ -93,11 +88,29 @@                          command_prereq = amInRepository,                          command_get_arg_possibilities = list_registered_files,                          command_argdefaults = nodefaults,-                         command_advanced_options = [ignoretimes, noskip_boring],+                         command_advanced_options = [ignoretimes, noskip_boring, no_cache],                          command_basic_options = [summary, unified,                                                  lookforadds,                                                  working_repo_dir]} +announce_files :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO ()+announce_files repo files =+    when (areFileArgs files) $ do+      nonboring <- restrictBoring+      working <- nonboring `fmap` readPlainTree "."+      pristine <- readRecordedAndPending repo+      let paths = map (fn2fp . sp2fn) files+          check = virtualTreeIO (mapM exists $ map floatPath paths)+      (in_working, _) <- check working+      (in_pending, _) <- check pristine+      mapM_ maybe_warn $ zip3 paths in_working in_pending+      putStrLn $ "What's new in "++unwords (map show files)++":\n"+    where maybe_warn (file, False, False) =+              putStrLn $ "WARNING: File '"++file++"' does not exist!"+          maybe_warn (file, True, False) =+              putStrLn $ "WARNING: File '" ++ file ++ "' not in repository!"+          maybe_warn _ = return ()+ whatsnew_cmd :: [DarcsFlag] -> [String] -> IO () whatsnew_cmd opts' args    | LookForAdds `elem` opts' && NoSummary `notElem` opts' =@@ -105,10 +118,7 @@     -- implies summary     withRepository (Summary:opts') $- \repository -> do     files <- fixSubPaths opts' args-    when (areFileArgs files)-            (do slurps <- slurp_recorded_and_unrecorded repository-                warn_if_bogus slurps files-                putStrLn $ "What's new in "++unwords (map show files)++":\n")+    announce_files repository files     all_changes <- get_unrecorded_in_files repository (map sp2fn files)     chold <- get_unrecorded_no_look_for_adds repository (map sp2fn files)     s <- slurp_recorded repository@@ -136,34 +146,15 @@   | otherwise =     withRepository opts $- \repository -> do     files <- sort `fmap` fixSubPaths opts args-    when (areFileArgs files)-      (do slurps <- slurp_recorded_and_unrecorded repository-          warn_if_bogus slurps files-          putStrLn $ "What's new in "++unwords (map show files)++":\n")-    changes <- get_unrecorded_in_files repository (map sp2fn files)+    announce_files repository files+    changes <- unrecordedChanges opts repository files     when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $ ExitFailure 1)     printSummary repository $ mapFL_FL prim2real changes        where printSummary :: RepoPatch p => Repository p C(r u t) -> FL RealPatch C(r y) -> IO ()              printSummary _ NilFL = do putStrLn "No changes!"                                        exitWith $ ExitFailure 1-             printSummary r ch = if Summary `elem` opts-                                 then putDocLn $ summarize ch-                                 else if Unified `elem` opts-                                      then do s <- slurp_recorded r-                                              contextualPrintPatch s ch-                                      else printPatch ch--warn_if_bogus :: (Slurpy,Slurpy) -> [SubPath] -> IO()-warn_if_bogus _ [] = return ()-warn_if_bogus (rec, pend) (f:fs) =-    do exist1 <- doesFileExist file-       exist2 <- doesDirectoryExist file-       let exist = exist1 || exist2-       if exist then when (not (slurp_has fp rec || slurp_has fp pend)) $-                       putStrLn $ "WARNING: File '"-                         ++file++"' not in repository!"-                else putStrLn $ "WARNING: File '"++file++"' does not exist!"-       warn_if_bogus (rec, pend) fs-    where fp =  toFilePath f-          file = encode_white fp+             printSummary r ch | Summary `elem` opts = putDocLn $ summarize ch+                               | Unified `elem` opts = do s <- slurp_recorded r+                                                          contextualPrintPatch s ch+                               | otherwise           = printPatch ch \end{code}
src/Darcs/CommandsAux.hs view
@@ -52,8 +52,10 @@ check_paths :: Patchy p => [DarcsFlag] -> FL p C(x y) -> IO () check_paths opts patches   = if check_is_on  && or (mapFL has_malicious_path patches)-      then fail "Malicious path"-           -- TODO: print patch(es) and path(s)+      then fail $ unlines $ ["Malicious path in patch:"] +++                            (map (\s -> "    " ++ s) $ concat $ mapFL malicious_paths patches) +++                            ["", "If you are sure this is ok then you can run again with the --dont-restrict-paths option."]+           -- TODO: print patch(es)            -- NOTE: should use safe Doc printer, this can be evil chars       else return ()  where@@ -66,8 +68,14 @@  has_malicious_path :: Patchy p => p C(x y) -> Bool has_malicious_path patch =+    case malicious_paths patch of+      [] -> False+      _ -> True++malicious_paths :: Patchy p => p C(x y) -> [String]+malicious_paths patch =   let paths = list_touched_files patch in-    any is_malicious_path paths+    filter is_malicious_path paths  {-|   What is a malicious path?
src/Darcs/Email.hs view
@@ -1,48 +1,146 @@ {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-}-module Darcs.Email ( make_email, read_email ) where+module Darcs.Email ( make_email, read_email, formatHeader ) where -import Data.Char ( digitToInt, isHexDigit )+import Data.Char ( digitToInt, isHexDigit, ord, intToDigit, isPrint, toUpper )+import Data.List ( isInfixOf )+import qualified UTF8 ( encode ) import Printer ( Doc, ($$), (<+>), (<>), text, empty, packedString, renderPS)  import ByteStringUtils (dropSpace, linesPS, betweenLinesPS )-import qualified Data.ByteString          as B  (ByteString, length, null, tail, drop, head)+import qualified Data.ByteString          as B  (ByteString, length, null, tail+                                                ,drop, head, concat, singleton+                                                ,pack, append, empty+                                                ) import qualified Data.ByteString.Char8    as BC (index, head, pack)-#if __GLASGOW_HASKELL__ > 606 import Data.ByteString.Internal as B (c2w, createAndTrim)-#else-import Data.ByteString.Base as B (c2w, createAndTrim)-#endif import System.IO.Unsafe ( unsafePerformIO ) import Foreign.Ptr ( Ptr, plusPtr ) import Foreign.Storable ( poke ) import Data.Word ( Word8 ) -line_max :: Int-line_max = 75+-- line_max is maximum number of characters in an e-mail line excluding the CRLF+-- at the end. qline_max is the number of characters in a q-encoded or+-- quoted-printable-encoded line.+line_max, qline_max :: Int+line_max  = 78+qline_max = 75 +-- | Formats an e-mail header by encoding any non-ascii characters using UTF-8+--   and Q-encoding, and folding lines at appropriate points. It doesn't do+--   more than that, so the header name and header value should be+--   well-formatted give or take line length and encoding. So no non-ASCII+--   characters within quoted-string, quoted-pair, or atom; no semantically+--   meaningful signs in names; no non-ASCII characters in the header name;+--   etcetera.+formatHeader :: String -> String -> B.ByteString+formatHeader headerName headerValue =+    B.append nameColon encodedValue+  where nameColon = B.pack (map B.c2w (headerName ++ ":")) -- space for folding+        encodedValue = fold_and_encode (' ':headerValue)+                                       (B.length nameColon) False False++-- run through a string and encode non-ascii words and fold where appropriate.+-- the integer argument is the current position in the current line.+-- the string in the first argument must begin with whitespace, or be empty.+fold_and_encode :: String -> Int -> Bool -> Bool -> B.ByteString+fold_and_encode [] _ _               _         = B.empty+fold_and_encode s  p lastWordEncoded inMidWord = +  let newline  = B.singleton 10+      space    = B.singleton 32+      s2bs     = B.pack . map B.c2w+      -- the twelve there is the max number of ASCII chars to encode a single+      -- character: 4 * 3, 4 UTF-8 bytes times 3 ASCII chars per byte+      safeEncChunkLength = (qline_max - B.length encoded_word_start+                                      - B.length encoded_word_end) `div` 12+      (curSpace, afterCurSpace) = break (not . (== ' ')) s+      (curWord,  afterCurWord)  = break (== ' ') afterCurSpace+      qEncWord | lastWordEncoded = qEncode (curSpace ++ curWord)+               | otherwise       = qEncode curWord+      mustEncode = inMidWord+                   || any (\c -> not (isPrint c) || (ord c) > 127) curWord+                   || length curWord > line_max - 1+                   || isInfixOf "=?" curWord+      mustFold+        | mustEncode && lastWordEncoded+            = p + 1 + B.length qEncWord > line_max+        | mustEncode+            = p + length curSpace + B.length qEncWord > line_max+        | otherwise+            = p + length curSpace + length curWord > line_max+      mustSplit = (B.length qEncWord > qline_max && mustEncode)+                  || length curWord > line_max - 1+      spaceToInsert | mustEncode && lastWordEncoded = space+                    | otherwise                     = s2bs curSpace+      wordToInsert+        | mustEncode && mustSplit = qEncode (take safeEncChunkLength curWord)+        | mustEncode = qEncWord+        | otherwise  = s2bs curWord+      doneChunk | mustFold  = B.concat [newline, spaceToInsert, wordToInsert]+                | otherwise = B.concat [spaceToInsert, wordToInsert]+      (rest, nextP)+        | mustSplit+            = (drop safeEncChunkLength curWord ++ afterCurWord, qline_max + 1)+        | mustEncode && mustFold +            = (afterCurWord, B.length spaceToInsert + B.length wordToInsert)+        | otherwise+            = (afterCurWord, p + B.length doneChunk)+  in B.append doneChunk (fold_and_encode rest nextP mustEncode mustSplit)++-- | Turns a piece of string into a q-encoded block+--   Applies q-encoding, for use in e-mail header values, as defined in RFC 2047.+--   It just takes a string and builds an encoded-word from it, it does not check+--   length or necessity.+qEncode :: String -> B.ByteString+qEncode s = B.concat [encoded_word_start,+                      encodedString,+                      encoded_word_end]+  where encodedString =  B.concat (map q_encode_char s)++encoded_word_start, encoded_word_end :: B.ByteString+encoded_word_start = B.pack (map B.c2w "=?UTF-8?Q?")+encoded_word_end   = B.pack (map B.c2w "?=")++-- turns a character into its q-encoded bytestring value. For most printable+-- ASCII characters, that's just the singleton bytestring with that char.+q_encode_char :: Char -> B.ByteString+q_encode_char c+    | c == ' '                          = c2bs '_'+    | isPrint c+      && not (c `elem` ['?', '=', '_'])+      && ord c < 128                    = c2bs c+    | otherwise                         = B.concat (map qbyte (UTF8.encode [c]))+  where c2bs = B.singleton . B.c2w+        -- qbyte turns a byte into its q-encoded "=hh" representation+        qbyte b = B.pack (map B.c2w ['='+                                    ,word8ToUDigit (b `div` 16)+                                    ,word8ToUDigit (b `mod` 16)+                                    ])+        word8ToUDigit :: Word8 -> Char+        word8ToUDigit = toUpper . intToDigit . fromIntegral+ -- TODO is this doing mime encoding?? qpencode :: B.ByteString -> B.ByteString qpencode s = unsafePerformIO            -- Really only (3 + 2/75) * length or something in the worst case-           $ B.createAndTrim (4 * B.length s) (\buf -> encode s line_max buf 0)+           $ B.createAndTrim (4 * B.length s) (\buf -> encode s qline_max buf 0)  encode :: B.ByteString -> Int -> Ptr Word8 -> Int -> IO Int encode ps _ _ bufi | B.null ps = return bufi encode ps n buf bufi = case B.head ps of   c | c == newline ->         do poke (buf `plusPtr` bufi) newline-           encode ps' line_max buf (bufi+1)+           encode ps' qline_max buf (bufi+1)     | n == 0 && B.length ps > 1 ->         do poke (buf `plusPtr` bufi) equals            poke (buf `plusPtr` (bufi+1)) newline-           encode ps line_max buf (bufi + 2)+           encode ps qline_max buf (bufi + 2)     | (c == tab || c == space) ->         if B.null ps' || B.head ps' == newline         then do poke (buf `plusPtr` bufi) c                 poke (buf `plusPtr` (bufi+1)) equals                 poke (buf `plusPtr` (bufi+2)) newline-                encode ps' line_max buf (bufi + 3)+                encode ps' qline_max buf (bufi + 3)         else do poke (buf `plusPtr` bufi) c                 encode ps' (n - 1) buf (bufi + 1)     | (c >= bang && c /= equals && c <= tilde) ->
src/Darcs/External.hs view
@@ -13,36 +13,36 @@     maybeURLCmd,     Cachable(Cachable, Uncachable, MaxAge),     viewDoc, viewDocWith,+    sendmail_path, diff_program   ) where -import Data.List ( intersperse )-import Control.Monad ( when, zipWithM_ )+import Data.Maybe ( isJust, isNothing, maybeToList )+import Control.Monad ( when, zipWithM_, filterM, liftM2 ) import System.Exit ( ExitCode(..) ) import System.Environment ( getEnv )-import System.Cmd ( system ) import System.IO ( hPutStr, hPutStrLn, hGetContents, hClose,                    openBinaryFile, IOMode( ReadMode ),                    openBinaryTempFile,                    hIsTerminalDevice, stdout, stderr, Handle ) import System.IO.Error ( isDoesNotExistError )-import System.IO.Unsafe ( unsafePerformIO ) import System.Posix.Files ( getSymbolicLinkStatus, isRegularFile, isDirectory ) import System.Directory ( createDirectory, getDirectoryContents,                           doesFileExist, doesDirectoryExist,-                          renameFile, renameDirectory, copyFile )+                          renameFile, renameDirectory, copyFile,+                          findExecutable ) import System.Process ( runProcess, runInteractiveProcess, waitForProcess ) import Control.Concurrent ( forkIO, newEmptyMVar, putMVar, takeMVar ) import Control.Exception ( bracket, try, finally ) import Data.Char ( toUpper )+#if defined (HAVE_MAPI) import Foreign.C ( CString, withCString )+#endif+#ifdef HAVE_MAPI import Foreign.Ptr ( nullPtr )+import Darcs.Lock ( canonFilename, writeDocBinFile )+#endif #ifdef HAVE_TERMINFO import System.Console.Terminfo( tiGetNum, setupTermFromEnv, getCapability )-#elif HAVE_CURSES-import Foreign.C ( CChar, CInt )-import Foreign.Ptr ( Ptr )-import Foreign.Marshal.Alloc (allocaBytes)-import Autoconf ( use_color ) #endif import System.Posix.Files ( createLink ) import System.Directory ( createDirectoryIfMissing )@@ -57,24 +57,37 @@ import ByteStringUtils (gzReadFilePS, linesPS, unlinesPS) import qualified Data.ByteString as B (ByteString, empty, null, readFile -- ratify readFile: Just an import from ByteString             ,hGetContents, writeFile, hPut, length -- ratify hGetContents: importing from ByteString-            ,take, concat, drop, isPrefixOf)+            ,take, concat, drop, isPrefixOf, singleton, append) import qualified Data.ByteString.Char8 as BC (unpack, pack) -import Darcs.Lock ( withTemp, withOpenTemp, tempdir_loc, canonFilename, writeDocBinFile,-                    removeFileMayNotExist, )+import Darcs.Lock ( withTemp, withOpenTemp, tempdir_loc, removeFileMayNotExist ) import CommandLine ( parseCmd, addUrlencoded )-import Autoconf ( have_libcurl, have_libwww, have_HTTP, have_sendmail, have_mapi, sendmail_path, darcs_version ) import URL ( copyUrl, copyUrlFirst, waitUrl ) import Ssh ( getSSH, copySSH, copySSHs, SSHCmd(..) ) import URL ( Cachable(..) ) import Exec ( exec, Redirect(..), withoutNonBlock ) import Darcs.URL ( is_file, is_url, is_ssh ) import Darcs.Utils ( catchall )-import Printer ( Doc, Printers, putDocLnWith, hPutDoc, hPutDocLn, hPutDocWith, ($$), (<+>), renderPS,+import Printer ( Doc, Printers, putDocLnWith, hPutDoc, hPutDocLn, hPutDocWith, ($$), renderPS,                  simplePrinters,                  text, empty, packedString, vcat, renderString )-#include "impossible.h"+import Darcs.Email ( formatHeader ) +sendmail_path :: IO String+sendmail_path = do+  l <- filterM doesFileExist $ liftM2 (</>)+                [ "/usr/sbin", "/sbin", "/usr/lib" ]+                [ "sendmail" ]+  ex <- findExecutable "sendmail"+  when (isNothing ex && null l) $ fail "Cannot find the \"sendmail\" program."+  return $ head $ maybeToList ex ++ l++diff_program :: IO String+diff_program = do+  l <- filterM (fmap isJust . findExecutable) [ "gdiff", "gnudiff", "diff" ]+  when (null l) $ fail "Cannot find the \"diff\" program."+  return $ head l+ backupByRenaming :: FilePath -> IO () backupByRenaming = backupBy rename  where rename x y = do@@ -200,13 +213,15 @@              `catch` \_ -> return Nothing  speculateRemote :: String -> FilePath -> IO () -- speculations are always Cachable+#if defined(HAVE_CURL) || defined(HAVE_HTTP) speculateRemote u v =     do maybeget <- maybeURLCmd "GET" u        case maybeget of          Just _ -> return () -- can't pipeline these-         Nothing -> if have_libwww || have_libcurl || have_HTTP-                    then copyUrl u v Cachable-                    else return ()+         Nothing -> copyUrl u v Cachable+#else+speculateRemote u _ = maybeURLCmd "GET" u >> return ()+#endif  copyRemote :: String -> FilePath -> Cachable -> IO () copyRemote u v cache =@@ -220,9 +235,7 @@                   fail $ "(" ++ get ++ ") failed to fetch: " ++ u  copyRemoteNormal :: String -> FilePath -> Cachable -> IO ()-copyRemoteNormal u v cache = if have_libwww || have_libcurl || have_HTTP-                             then copyUrlFirst u v cache >> waitUrl u-                             else copyRemoteCmd u v+copyRemoteNormal u v cache = copyUrlFirst u v cache >> waitUrl u  copyFilesOrUrls :: [DarcsFlag]->FilePath->[String]->FilePath->Cachable->IO () copyFilesOrUrls opts dou ns out _ | is_file dou = copyLocals opts dou ns out@@ -272,67 +285,12 @@  copyRemotesNormal :: String -> [String] -> FilePath -> Cachable -> IO() copyRemotesNormal u ns d cache =-    if have_libwww || have_libcurl || have_HTTP-    then do mapM_ (\n -> copyUrl (u++"/"++n) (d++"/"++n) cache) ns-            doWithPatches (\n -> waitUrl (u++"/"++n)) ns-    else wgetRemotes u ns d---- Argh, this means darcs get will fail if we don't have libcurl and don't--- have wget.  :(-wgetRemotes :: String -> [String] -> FilePath -> IO ()-wgetRemotes u ns d = do wget_command <- getEnv "DARCS_WGET" `catch`-                                               \_ -> return "wget"-                        let (wget, wget_args) = breakCommand wget_command-                            input = unlines $ map (\n -> u++"/"++n) ns-                        withCurrentDirectory d $ withOpenTemp $ \(th,tn) ->-                            do hPutStr th input-                               hClose th-                               r <- exec wget (wget_args++["-i",tn])-                                         (Null,Null,AsIs)-                               when (r /= ExitSuccess) $-                                    fail $ unlines $-                                             ["(wget) failed to fetch files.",-                                              "source directory: " ++ d,-                                              "source files:"] ++ ns--copyRemoteCmd :: String -> FilePath -> IO ()-copyRemoteCmd s tmp = do-    let cmd = get_ext_cmd-    r <- stupidexec (cmd tmp s) (Null,Null,AsIs)-    when (r /= ExitSuccess) $-         fail $ "failed to fetch: " ++ s ++" " ++ show r-    where stupidexec [] = bug "stupidexec without a command"-          stupidexec xs = exec (head xs) (tail xs)+    do mapM_ (\n -> copyUrl (u++"/"++n) (d++"/"++n) cache) ns+       doWithPatches (\n -> waitUrl (u++"/"++n)) ns  doWithPatches :: (String -> IO ()) -> [String] -> IO () doWithPatches f patches = mapM_ (\p -> seq p $ f p) $ progressList "Copying patch" patches -{-# NOINLINE get_ext_cmd #-}-get_ext_cmd :: String -> String -> [String]--- Only need to find the command once..-get_ext_cmd = unsafePerformIO get_ext_cmd'---- Would be better to read possible command lines from config-file..-get_ext_cmd' :: IO (String -> String -> [String])-get_ext_cmd' = try_cmd cmds-    where cmds = [("wget", (("--version",0),-                          -- use libcurl for proper cache control-                          \t s -> ["wget", "-q",-                                   "--header=Pragma: no-cache",-                                   "--header=Cache-Control: no-cache",-                                   "-O",t,s])),-                  ("curl", (("--version",2),-                            \t s -> ["curl", "-s", "-f", "-L",-                                     "-H", "Pragma: no-cache",-                                     "-H", "Cache-Control: no-cache",-                                     "-o",t,s]))]-          try_cmd [] = fail $ "I need one of: " ++ cs-              where cs = concat $ intersperse ", " (map fst cmds)-          try_cmd ((c,(ok_check,f)):cs) = do-            True <- can_execute ok_check c-            return f-           `catch` (\_ -> try_cmd cs)- -- | Run a command on a remote location without passing it any input or --   reading its output.  Return its ExitCode execSSH :: String -> String -> IO ExitCode@@ -383,18 +341,19 @@     -> Doc     -- ^ body     -> IO () generateEmail h f t s cc body = do-     hPutDocLn h $-           text "To:"      <+> text t-        $$ text "From:"    <+> text f-        $$ text "Subject:" <+> text s-        $$ formated_cc-        $$ text "X-Mail-Originator: Darcs Version Control System"-        $$ text ("X-Darcs-Version: " ++ darcs_version)-        $$ body-  where formated_cc = if cc == ""-                      then empty-                      else text "Cc:" <+> text cc+     putHeader "To" t+     putHeader "From" f+     putHeader "Subject" s+     when (not (null cc)) (putHeader "Cc" cc)+     putHeader "X-Mail-Originator" "Darcs Version Control System"+     hPutDocLn h body+  where putHeader field value+            = B.hPut h (B.append (formatHeader field value) newline)+        newline = B.singleton 10 +have_sendmail :: IO Bool+have_sendmail = (sendmail_path >> return True) `catch` (\_ -> return False)+ -- | Send an email, optionally containing a patch bundle --   (more precisely, its description and the bundle itself) sendEmailDoc@@ -409,8 +368,9 @@ sendEmailDoc _ "" _ "" _ _ _ = return () sendEmailDoc f "" s cc scmd mbundle body =   sendEmailDoc f cc s "" scmd mbundle body-sendEmailDoc f t s cc scmd mbundle body =-  if have_sendmail || scmd /= "" then do+sendEmailDoc f t s cc scmd mbundle body = do+  use_sendmail <- have_sendmail+  if use_sendmail || scmd /= "" then do     withOpenTemp $ \(h,fn) -> do       generateEmail h f t s cc body       hClose h@@ -427,7 +387,8 @@         when (r /= ExitSuccess) $ fail ("failed to send mail to: "                                        ++ t ++ cc_list cc                                        ++ "\nPerhaps sendmail is not configured.")-  else if have_mapi then do+#ifdef HAVE_MAPI+   else do      r <- withCString t $ \tp ->            withCString f $ \fp ->             withCString cc $ \ccp ->@@ -440,7 +401,9 @@                withCString cfn $ \pcfn ->                 c_send_email fp tp ccp sp nullPtr pcfn      when (r /= 0) $ fail ("failed to send mail to: " ++ t)-  else fail $ "no mail facility (sendmail or mapi) located at configure time!"+#else+   else fail $ "no mail facility (sendmail or mapi) located at configure time!"+#endif   where addressOnly a =           case dropWhile (/= '<') a of           ('<':a2) -> takeWhile (/= '>') a2@@ -451,9 +414,10 @@  resendEmail :: String -> String -> B.ByteString -> IO () resendEmail "" _ _ = return ()-resendEmail t scmd body =-  case (have_sendmail || scmd /= "", have_mapi) of-   (True, _) -> do+resendEmail t scmd body = do+  use_sendmail <- have_sendmail+  if use_sendmail || scmd /= ""+   then do     withOpenTemp $ \(h,fn) -> do      hPutStrLn h $ "To: "++ t      hPutStrLn h $ find_from (linesPS body)@@ -463,8 +427,12 @@      let ftable = [('t',t)]      r <-  execSendmail ftable scmd fn      when (r /= ExitSuccess) $ fail ("failed to send mail to: " ++ t)-   (_, True) -> fail "Don't know how to resend email with MAPI"-   _ -> fail $ "no mail facility (sendmail or mapi) located at configure time (use the sendmail-command option)!"+   else+#ifdef HAVE_MAPI+    fail "Don't know how to resend email with MAPI"+#else+    fail "no mail facility (sendmail or mapi) located at configure time (use the sendmail-command option)!"+#endif   where br            = BC.pack "\r"         darcsurl      = BC.pack "DarcsURL:"         content       = BC.pack "Content-"@@ -486,8 +454,9 @@  execSendmail :: [(Char,String)] -> String -> String -> IO ExitCode execSendmail ftable scmd fn =-  if scmd == "" then-     exec sendmail_path ["-i", "-t"] (File fn, Null, AsIs)+  if scmd == "" then do+     cmd <- sendmail_path+     exec cmd ["-i", "-t"] (File fn, Null, AsIs)   else case parseCmd (addUrlencoded ftable) scmd of          Right (arg0:opts, wantstdin) ->            do let stdin = if wantstdin then File fn else Null@@ -497,9 +466,6 @@  #ifdef HAVE_MAPI foreign import ccall "win32/send_email.h send_email" c_send_email-#else-c_send_email-#endif              :: CString -> {- sender -}                 CString -> {- recipient -}                 CString -> {- cc -}@@ -507,8 +473,6 @@                 CString -> {- body -}                 CString -> {- path -}                 IO Int-#ifndef HAVE_MAPI-c_send_email = impossible #endif  execPSPipe :: String -> [String] -> B.ByteString -> IO B.ByteString@@ -632,54 +596,21 @@                        _ -> return Nothing     where opensslPS = execPSPipe "openssl" -can_execute :: (String,Int) -> String -> IO Bool-can_execute (arg,expected_return_value) exe = do- withTemp $ \junk -> do-  ec <- system (unwords [exe,arg,">",junk])-  case ec of-    ExitSuccess | expected_return_value == 0 -> return True-    ExitFailure r | r == expected_return_value -> return True-    _ -> return False - {-   - This function returns number of colors supported by current terminal   - or -1 if color output not supported or error occured.   - Terminal type determined by TERM env. variable.   -} getTermNColors :: IO Int- #ifdef HAVE_TERMINFO getTermNColors = do   t <- setupTermFromEnv   return $ case getCapability t $ tiGetNum "colors" of     Nothing -> (-1)     Just x -> x--#elif HAVE_CURSES--foreign import ccall "tgetnum" c_tgetnum :: CString -> IO CInt-foreign import ccall "tgetent" c_tgetent :: Ptr CChar -> CString -> IO CInt--termioBufSize :: Int-termioBufSize = 4096--getTermNColors = if not use_color-                 then return (-1)-                 else do term <- getEnv "TERM"-                         allocaBytes termioBufSize (getTermNColorsImpl term)-                      `catch` \_ -> return (-1)--getTermNColorsImpl :: String -> Ptr CChar -> IO Int-getTermNColorsImpl term buf = do rc <- withCString term $-                                       \termp -> c_tgetent buf termp-                                 x <- if (rc /= 1) then return (-1)  else withCString "Co" $ \capap -> c_tgetnum capap-                                 return $ fromIntegral x- #else- getTermNColors = return (-1)- #endif  viewDoc :: Doc -> IO ()
src/Darcs/Flags.hs view
@@ -15,14 +15,16 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -module Darcs.Flags ( DarcsFlag( .. ), Compression( .. ), compression, want_external_merge, isInteractive) where+module Darcs.Flags ( DarcsFlag( .. ), Compression( .. ), compression, want_external_merge, isInteractive,+                     maxCount,+                   ) where import Darcs.Patch.MatchData ( PatchMatch ) import Darcs.RepoPath ( AbsolutePath, AbsolutePathOrStd )  -- | The 'DarcsFlag' type is a list of all flags that can ever be -- passed to darcs, or to one of its commands. data DarcsFlag = Help | ListOptions | NoTest | Test-               | HelpOnMatch | OnlyChangesToFiles+               | OnlyChangesToFiles                | LeaveTestDir | NoLeaveTestDir                | Timings | Debug | DebugVerbose | DebugHTTP                | Verbose | NormalVerbosity | Quiet@@ -32,7 +34,7 @@                | SendmailCmd String | Author String | PatchName String                | OnePatch String | SeveralPatch String                | AfterPatch String | UpToPatch String-               | TagName String | LastN Int | PatchIndexRange Int Int+               | TagName String | LastN Int | MaxCount Int | PatchIndexRange Int Int                | NumberPatches                | OneTag String | AfterTag String | UpToTag String                | Context AbsolutePath | Count@@ -85,6 +87,7 @@                | HTTPPipelining | NoHTTPPipelining                | NoCache                | AllowUnrelatedRepos+               | Check | Repair | JustThisRepo                | NullFlag                  deriving ( Eq, Show ) @@ -107,3 +110,7 @@       isInteractive_ _ (DryRun:fs) = isInteractive_ False fs       isInteractive_ def (_:fs) = isInteractive_ def fs +maxCount :: [DarcsFlag] -> Maybe Int+maxCount (MaxCount n : _) = Just n+maxCount (_:xs) = maxCount xs+maxCount [] = Nothing
src/Darcs/Global.hs view
@@ -15,6 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +{-# LANGUAGE CPP #-} -- | This was originally Tomasz Zielonka's AtExit module, slightly generalised -- to include global variables.  Here, we attempt to cover broad, global -- features, such as exit handlers.  These features slightly break the Haskellian@@ -25,6 +26,9 @@                       timingsMode, setTimingsMode,                       whenDebugMode, withDebugMode, setDebugMode,                       debugMessage, debugFail, putTiming,+#ifdef HAVE_HASKELL_ZLIB+                      addCRCWarning, getCRCWarnings, resetCRCWarnings,+#endif                       darcsdir     ) where @@ -32,6 +36,9 @@ import Control.Concurrent.MVar import Control.Exception (bracket_, catch, block, unblock) import Data.IORef ( IORef, newIORef, readIORef, writeIORef )+#ifdef HAVE_HASKELL_ZLIB+import Data.IORef ( modifyIORef )+#endif import System.IO.Unsafe (unsafePerformIO) import System.IO (hPutStrLn, hPutStr, stderr) import System.Time ( calendarTimeToString, toCalendarTime, getClockTime )@@ -41,6 +48,8 @@ atexit_actions :: MVar (Maybe [IO ()]) atexit_actions = unsafePerformIO (newMVar (Just [])) +-- | Registers an IO action to run just before darcs exits.  Useful+-- for removing temporary files and directories, for example. atexit :: IO () -> IO () atexit action = do     modifyMVar_ atexit_actions $ \ml -> do@@ -129,6 +138,22 @@ {-# NOINLINE sshControlMasterDisabled #-} sshControlMasterDisabled :: Bool sshControlMasterDisabled = unsafePerformIO $ readIORef _sshControlMasterDisabled++#ifdef HAVE_HASKELL_ZLIB+type CRCWarningList = [FilePath]+{-# NOINLINE _crcWarningList #-}+_crcWarningList :: IORef CRCWarningList+_crcWarningList = unsafePerformIO $ newIORef []++addCRCWarning :: FilePath -> IO ()+addCRCWarning fp = modifyIORef _crcWarningList (fp:)++getCRCWarnings :: IO [FilePath]+getCRCWarnings = readIORef _crcWarningList++resetCRCWarnings :: IO ()+resetCRCWarnings = writeIORef _crcWarningList []+#endif  darcsdir :: String darcsdir = "_darcs"
+ src/Darcs/Gorsvet.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE CPP, FlexibleInstances #-}+{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}++-- Copyright (C) 2009 Petr Rockai+--+-- Permission is hereby granted, free of charge, to any person+-- obtaining a copy of this software and associated documentation+-- files (the "Software"), to deal in the Software without+-- restriction, including without limitation the rights to use, copy,+-- modify, merge, publish, distribute, sublicense, and/or sell copies+-- of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be+-- included in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++#include "gadts.h"++module Darcs.Gorsvet where++import Prelude hiding ( all, filter, lines, read, readFile, writeFile )++-- darcs stuff+import ByteStringUtils( is_funky )+import Darcs.Repository ( Repository, slurp_pending )+import Darcs.Repository.Internal ( read_pending )+import Darcs.Patch ( RepoPatch, Prim, hunk, canonize, binary, apply+                   , sort_coalesceFL, addfile, rmfile, adddir, rmdir, invert)+import Darcs.Ordered ( FL(..), (+>+) )+import Darcs.Repository.Prefs ( filetype_function, FileType(..) )+import Darcs.IO+import Darcs.Sealed ( Sealed(Sealed), seal )+import Darcs.Patch( apply_to_filepaths )+import Darcs.Patch.Patchy ( Apply )+import Darcs.Patch.TouchesFiles ( choose_touching )+import Darcs.Patch.FileName ( fn2fp, FileName )++import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Char8 as BS+import Control.Monad.State.Strict+import System.Directory( removeFile, doesFileExist )+import Data.Maybe+import Data.List( union )++import Darcs.Arguments ( DarcsFlag( LookForAdds, IgnoreTimes ) )+import Darcs.RepoPath ( SubPath, sp2fn )++import Text.Regex( matchRegex )+import Darcs.Repository.Prefs( boring_regexps )++import Storage.Hashed+import Storage.Hashed.Tree+import qualified Storage.Hashed.Index as I+import Storage.Hashed.AnchoredPath+import Storage.Hashed.Darcs( darcsFormatHash, darcsTreeHash )+import Storage.Hashed.Monad+    ( virtualTreeIO, hashedTreeIO, plainTreeIO+    , unlink, rename, createDirectory, writeFile+    , readFile -- ratify readFile: haskell_policy je natvrdlá+    , cwd, tree, TreeIO )+import Storage.Hashed++floatFn :: FileName -> AnchoredPath+floatFn = floatPath . fn2fp++instance ReadableDirectory TreeIO where+    mDoesDirectoryExist d = gets (\x -> isJust $ findTree (tree x) (floatFn d))+    mDoesFileExist f = gets (\x -> isJust $ findFile (tree x) (floatFn f))+    mInCurrentDirectory d action = do -- TODO bracket?+      wd <- gets cwd+      modify (\x -> x { cwd = floatFn d })+      x <- action+      modify (\x' -> x' { cwd = wd })+      return x+    mGetDirectoryContents = error "get dir contents"+    mReadFilePS p = do x <- readFile (floatFn p) -- ratify readFile: ...+                       return $ BS.concat (BL.toChunks x)++instance WriteableDirectory TreeIO where+    mWithCurrentDirectory = mInCurrentDirectory+    mSetFileExecutable _ _ = return ()+    mWriteFilePS p ps = writeFile -- ratify readFile: haskell_policy is stupid.+          (floatFn p) (BL.fromChunks [ps])+    mCreateDirectory p = createDirectory (floatFn p)+    mRename from to = rename (floatFn from) (floatFn to)+    mRemoveDirectory = unlink . floatFn+    mRemoveFile = unlink . floatFn++treeDiff :: (FilePath -> FileType) -> Tree -> Tree -> IO (FL Prim C(x y))+#ifdef GADT_WITNESSES+treeDiff = undefined -- Sigh.+#else+treeDiff ft t1 t2 = do+  (from, to) <- diffTrees t1 t2+  diffs <- sequence $ zipTrees diff from to+  return $ foldr (+>+) NilFL diffs+    where diff :: AnchoredPath -> Maybe TreeItem -> Maybe TreeItem+               -> IO (FL Prim)+          diff _ (Just (SubTree _)) (Just (SubTree _)) = return NilFL+          diff p (Just (SubTree _)) Nothing =+              return $ rmdir (anchorPath "" p) :>: NilFL+          diff p Nothing (Just (SubTree _)) =+              return $ adddir (anchorPath "" p) :>: NilFL+          diff p Nothing b'@(Just (File _)) =+              do diff' <- diff p (Just (File emptyBlob)) b'+                 return $ addfile (anchorPath "" p) :>: diff'+          diff p a'@(Just (File _)) Nothing =+              do diff' <- diff p a' (Just (File emptyBlob))+                 return $ diff' +>+ (rmfile (anchorPath "" p) :>: NilFL)+          diff p (Just (File a')) (Just (File b')) =+              do a <- read a'+                 b <- read b'+                 let path = anchorPath "" p+                 case ft path of+                   TextFile | no_bin a && no_bin b ->+                                return $ text_diff path a b+                   _ -> return $ if a /= b+                                    then binary path (strict a) (strict b) :>: NilFL+                                    else NilFL+          diff p _ _ = fail $ "Missing case at path " ++ show p+          text_diff p a b+              | BL.null a && BL.null b = NilFL+              | BL.null a = diff_from_empty p b+              | BL.null b = diff_to_empty p a+              | otherwise = line_diff p (lines a) (lines b)+          line_diff p a b = canonize (hunk p 1 a b)+          diff_to_empty p x | BL.last x == '\n' = line_diff p (init $ lines x) []+                            | otherwise = line_diff p (lines x) [BS.empty]+          diff_from_empty p x = invert (diff_to_empty p x)+          no_bin = not . is_funky . strict . BL.take 4096+          lines = map strict . BL.split '\n'+          strict = BS.concat . BL.toChunks+#endif++readRecorded :: (RepoPatch p) => Repository p C(r u t) -> IO Tree+readRecorded _ = readDarcsPristine "."++readRecordedAndPending :: (RepoPatch p) => Repository p C(r u t) -> IO Tree+readRecordedAndPending repo = do+  pristine <- readRecorded repo+  Sealed pending <- pendingChanges repo []+  applyToTree pending pristine++pendingChanges :: (RepoPatch p) => Repository p C(r u t)+               -> [SubPath] -> IO (Sealed (FL Prim C(r)))+pendingChanges repo paths = do+  slurp_pending repo -- XXX: only here to get us the "pending conflicts" check+                     -- that I don't know yet how to implement properly+  Sealed pending <- read_pending repo+  let files = map (fn2fp . sp2fn) paths+      pre_files = apply_to_filepaths (invert pending) files+      relevant = case paths of+                   [] -> seal pending+                   _ -> choose_touching pre_files pending+  return relevant++applyToTree :: (Apply p) => p C(x y) -> Tree -> IO Tree+applyToTree patch t = snd `fmap` virtualTreeIO (apply [] patch) t++unrecordedChanges :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t)+                  -> [SubPath] -> IO (FL Prim C(r y))+unrecordedChanges opts repo paths = do+  pristine <- readDarcsPristine "."+  Sealed pending <- pendingChanges repo paths+  (_, current') <- virtualTreeIO (apply [] pending) pristine+  relevant <- restrictSubpaths repo paths+  nonboring <- restrictBoring++  let current = relevant current'+  working <- case (LookForAdds `elem` opts, IgnoreTimes `elem` opts) of+               (False, False) -> do+                 all <- readIndex repo+                 expand (relevant all)+               (False, True) -> do+                 guide <- expand current+                 all <- readPlainTree "."+                 return $ relevant $ (restrict guide) all+               -- TODO (True, False) could use a more efficient implementation...+               (True, _) -> do+                 all <- readPlainTree "."+                 return $ relevant $ nonboring all++  ft <- filetype_function+  diff <- treeDiff ft current working+  return $ sort_coalesceFL (pending +>+ diff)++applyToTentativePristine :: (Apply p) => t -> p C(x y) -> IO ()+applyToTentativePristine _ patches =+    do pristine <- readDarcsPristine "."+       (_, t) <- hashedTreeIO (apply [] patches)+                 pristine "_darcs/pristine.hashed"+       BS.writeFile "_darcs/tentative_pristine" $+         BS.concat [BS.pack "pristine:"+                   , darcsFormatHash (fromJust $ treeHash t)]++applyToWorking :: (RepoPatch p) => Repository p C(r u t)+               -> Sealed (FL Prim C(u)) -> IO Tree+applyToWorking repo (Sealed patches) =+    do working <- readIndex repo+       snd `fmap` plainTreeIO (apply [] patches) working "."++filter_paths :: [AnchoredPath] -> AnchoredPath -> t -> Bool+filter_paths files =+    \p _ -> any (\x -> x `isPrefix` p || p `isPrefix` x) files++restrict_paths :: [AnchoredPath] -> Tree -> Tree+restrict_paths files = if null files+                          then id+                          else filter $ filter_paths files++restrict_subpaths :: [SubPath] -> Tree -> Tree+restrict_subpaths = restrict_paths . map (floatPath . fn2fp . sp2fn)++restrictSubpaths :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO (Tree -> Tree)+restrictSubpaths repo subpaths = do+  Sealed pending <- read_pending repo+  let paths = map (fn2fp . sp2fn) subpaths+      paths' = paths `union` apply_to_filepaths pending paths+      anchored = map floatPath paths'+  return $ restrict_paths anchored++restrictBoring :: IO (Tree -> Tree)+restrictBoring = do+  boring <- boring_regexps+  let boring' (AnchoredPath (Name x:_)) _ | x == BS.pack "_darcs" = False+      boring' p _ = not $ any (\rx -> isJust $ matchRegex rx p') boring+          where p' = anchorPath "" p+  return $ filter boring'++readIndex :: (RepoPatch p) => Repository p C(r u t) -> IO Tree+readIndex repo = do+  invalid <- doesFileExist "_darcs/index_invalid"+  exist <- doesFileExist "_darcs/index"+  format_valid <- if exist+                     then I.indexFormatValid "_darcs/index"+                     else return True+  when (exist && not format_valid) $ removeFile "_darcs/index"+  if (not exist || invalid || not format_valid)+     then do pris <- readRecordedAndPending repo+             idx <- I.updateIndexFrom "_darcs/index" darcsTreeHash pris+             when invalid $ removeFile "_darcs/index_invalid"+             return idx+     else I.readIndex "_darcs/index" darcsTreeHash++invalidateIndex :: t -> IO ()+invalidateIndex _ = do+  BS.writeFile "_darcs/index_invalid" BS.empty
src/Darcs/Lock.hs view
@@ -28,6 +28,7 @@               rm_recursive, removeFileMayNotExist,               canonFilename, maybeRelink,               world_readable_temp, tempdir_loc,+              environmentHelpTmpdir, environmentHelpKeepTmpdir             ) where  import Prelude hiding ( catch )@@ -167,7 +168,16 @@               >>= return . fromJust     where chkdir Nothing = return Nothing           chkdir (Just d) = doesDirectoryExist d >>= return . \e -> if e then Just (d++"/") else Nothing-                                                         ++environmentHelpTmpdir :: ([String], [String])+environmentHelpTmpdir = (["DARCS_TMPDIR", "TMPDIR"], [+ "Darcs often creates temporary directories.  For example, the `darcs",+ "diff' command creates two for the working trees to be diffed.  By",+ "default temporary directories are created in /tmp, or if that doesn't",+ "exist, in _darcs (within the current repo).  This can be overridden by",+ "specifying some other directory in the file _darcs/prefs/tmpdir or the",+ "environment variable $DARCS_TMPDIR or $TMPDIR."])+ getCurrentDirectorySansDarcs :: IO (Maybe FilePath) getCurrentDirectorySansDarcs = do   c <- getCurrentDirectory@@ -177,6 +187,7 @@ data WithDirKind = Perm | Temp | Delayed  withDir :: WithDirKind -> String -> (AbsolutePath -> IO a) -> IO a+withDir _ "" _ = bug "withDir called with empty directory name" withDir kind abs_or_relative_name job = do   absolute_name <- if is_relative abs_or_relative_name                    then fmap (++ abs_or_relative_name) tempdir_loc@@ -204,6 +215,14 @@                               _ -> throwIO e)           keep_tmpdir = isJust `fmap` maybeGetEnv "DARCS_KEEP_TMPDIR" +environmentHelpKeepTmpdir :: ([String], [String])+environmentHelpKeepTmpdir = (["DARCS_KEEP_TMPDIR"],[+ "If the environment variable DARCS_KEEP_TMPDIR is defined, darcs will",+ "not remove the temporary directories it creates.  This is intended",+ "primarily for debugging Darcs itself, but it can also be useful, for",+ "example, to determine why your test preference (see `darcs setpref')",+ "is failing when you run `darcs record', but working when run manually."])+ -- |'withPermDir' is like 'withTempDir', except that it doesn't -- delete the directory afterwards. withPermDir :: String -> (AbsolutePath -> IO a) -> IO a@@ -241,7 +260,7 @@           then removeFile d           else when isd $ do conts <- actual_dir_contents                              withCurrentDirectory d $-                               (sequence_ $ map rm_recursive conts)+                               mapM_ rm_recursive conts                              removeDirectory d     where actual_dir_contents = -- doesn't include . or ..               do c <- getDirectoryContents d@@ -251,9 +270,11 @@ world_readable_temp f = wrt 0     where wrt :: Int -> IO String           wrt 100 = fail $ "Failure creating temp named "++f-          wrt n = do ok <- takeFile $ f++"-"++show n-                     if ok then return $ f++"-"++show n-                           else wrt (n+1)+          wrt n = let f_new = f++"-"++show n+                  in do ok <- takeFile f_new+                        if ok then do atexit $ removeFileMayNotExist f_new+                                      return f_new+                              else wrt (n+1)  withNamedTemp :: String -> (String -> IO a) -> IO a withNamedTemp n = bracket get_empty_file removeFileMayNotExist
src/Darcs/Match.lhs view
@@ -170,7 +170,7 @@                          else get_matcher_s Inclusive m repo  --- | @first_match fs@ tells whether @fs@ implies a "second match", that+-- | @second_match fs@ tells whether @fs@ implies a "second match", that -- is if we match against patches up to a point in the past on, rather -- than against all patches until now. second_match :: [DarcsFlag] -> Bool
src/Darcs/Patch.lhs view
@@ -145,6 +145,7 @@  \input{Darcs/Patch/Apply.lhs} \input{Darcs/Patch/Core.lhs}+\input{Darcs/Patch/Prim.lhs} \input{Darcs/Patch/Commute.lhs} \input{Darcs/Patch/Show.lhs}
src/Darcs/Patch/Apply.lhs view
@@ -28,9 +28,7 @@                            patchChanges,                            applyToPop,                            LineMark(..), MarkedUpFile,-                           force_replace_slurpy,-                           -- to cut later:-                           applyBinary )+                           force_replace_slurpy )     where  import Prelude hiding ( catch, pi )@@ -52,7 +50,7 @@ import Darcs.Patch.Core ( Patch(..), Named(..) ) import Darcs.Patch.Prim ( Prim(..), Effect(effect),                           DirPatchType(..), FilePatchType(..),-                          applyBinary, try_tok_internal )+                          try_tok_internal ) import Darcs.Patch.Info ( PatchInfo ) import Control.Monad ( when ) import Darcs.SlurpDirectory ( FileContents, Slurpy, withSlurpy, slurp_modfile )
src/Darcs/Patch/Check.hs view
@@ -19,21 +19,36 @@                     remove_file, remove_dir, create_file, create_dir,                     insert_line, delete_line, is_valid, do_verbose_check,                     file_empty,-                    check_move, modify_file, Possibly(..)+                    check_move, modify_file, FileContents(..)                   ) where -import Text.Regex ( mkRegex, matchRegex ) import System.IO.Unsafe ( unsafePerformIO ) import qualified Data.ByteString as B (ByteString)-import Data.List (isPrefixOf)--newtype PatchCheck a = PC( KnownState -> (KnownState, a) )+import Data.List ( isPrefixOf, inits )+import Control.Monad.State ( State, evalState, runState )+import Control.Monad.State.Class ( get, put, modify )+-- use Map, not IntMap, because Map has mapKeys and IntMap hasn't+import Data.Map ( Map )+import qualified Data.Map as M ( mapKeys, delete, insert, empty, lookup, null )+import System.FilePath ( joinPath, splitDirectories ) -data Possibly a = PJust a | PNothing | PSomething-                  deriving (Eq, Show)+-- | File contents are represented by a map from line numbers to line contents.+--   If for a certain line number, the line contents are Nothing, that means+--   that we are sure that that line exists, but we don't know its contents.+--   We must also store the greatest line number that is known to exist in a+--   file, to be able to exclude the possibility of it being empty without+--   knowing its contents.+data FileContents = FC { fc_lines   :: Map Int B.ByteString+                       , fc_maxline :: Int+                       } deriving (Eq, Show) data Prop = FileEx String | DirEx String | NotEx String-          | FileLines String [Possibly B.ByteString]+          | FileLines String FileContents             deriving (Eq)+-- | A @KnownState@ is a simulated repository state. The repository is either+-- inconsistent, or it has two lists of properties: one list with properties+-- that hold for this repo, and one with properties that do not hold for this+-- repo. These two lists may not have any common elements: if they had, the+-- repository would be inconsistent. data KnownState = P [Prop] [Prop]                 | Inconsistent                   deriving (Show)@@ -41,34 +56,45 @@     show (FileEx f) = "FileEx "++f     show (DirEx d)  = "DirEx "++d     show (NotEx f) = "NotEx"++f-    show (FileLines f l)  = "FileLines "++f++" "++show (take 10 l)+    show (FileLines f l)  = "FileLines "++f++": "++show l -instance Monad PatchCheck where-    (PC p) >>= k  =  PC( \s0 -> let (s1, a) = p s0-                                    (PC q) = k a-                                in q s1 )-    return a = PC( \s -> (s, a) )+-- | PatchCheck is a state monad with a simulated repository state+type PatchCheck = State KnownState +-- | The @FileContents@ structure for an empty file+empty_filecontents :: FileContents+empty_filecontents = FC M.empty 0++-- | Returns a given value if the repository state is inconsistent, and performs+--   a given action otherwise.+handle_inconsistent :: a            -- ^ The value to return if the state is inconsistent+                   -> PatchCheck a -- ^ The action to perform otherwise+                   -> PatchCheck a+handle_inconsistent v a = do state <- get+                             case state of+                               Inconsistent -> return v+                               _            -> a+ do_check :: PatchCheck a -> a-do_check (PC p) = snd $ p (P [] [])+do_check p = evalState p (P [] []) +-- | Run a check, and print the final repository state do_verbose_check :: PatchCheck a -> a-do_verbose_check (PC p) =-    case p (P [] []) of-    (pc, b) -> unsafePerformIO $ do putStrLn $ show pc+do_verbose_check p =+    case runState p (P [] []) of+    (b, pc) -> unsafePerformIO $ do putStrLn $ show pc                                     return b +-- | Returns true if the current repository state is not inconsistent is_valid :: PatchCheck Bool-is_valid = PC iv-    where iv Inconsistent = (Inconsistent, False)-          iv m = (m, True)+is_valid = handle_inconsistent False (return True)  has :: Prop -> [Prop] -> Bool has _ [] = False has k (k':ks) = k == k' || has k ks  modify_file :: String-            -> ([Possibly B.ByteString]-> Maybe [Possibly B.ByteString])+            -> (Maybe FileContents -> Maybe FileContents)             -> PatchCheck Bool modify_file f change = do     file_exists f@@ -81,63 +107,67 @@ insert_line :: String -> Int -> B.ByteString -> PatchCheck Bool insert_line f n l = do     c <- file_contents f-    case il n c of-       [] -> assert_not $ FileEx f-       c' -> do-             set_contents f c'-             return True-  where il 1 mls = (PJust l:mls)-        il i (ml:mls) = ml : il (i-1) mls-        il _ [] = []+    case c of+      Nothing -> assert_not $ FileEx f -- in this case, the repo is inconsistent+      Just c' -> do+        let lines'   = M.mapKeys (\k -> if k >= n then k+1 else k) (fc_lines c')+            lines''  = M.insert n l lines'+            maxline' = max n (fc_maxline c')+        set_contents f (FC lines'' maxline')+        return True  -- deletes a line from a hunk patch (third argument) in the given file (first -- argument) at the given line number (second argument) delete_line :: String -> Int -> B.ByteString -> PatchCheck Bool delete_line f n l = do     c <- file_contents f-    case dl [] n c of-        Nothing -> assert_not $ FileEx f-        Just c' -> do-            set_contents f c'-            is_valid-  where dl _ _ [] = Nothing-        dl o 1 (ml':ls) =-            case ml' of-            PSomething -> Just $ reverse o ++ ls-            PNothing -> Just $ reverse o ++ ls-            PJust l' -> if l' == l then Just $ reverse o ++ ls-                                   else Nothing-        dl o i (ml:mls) =-            case ml of-            PNothing -> dl (PSomething:o) (i-1) mls-            _ -> dl (ml:o) (i-1) mls+    case c of+      Nothing -> assert_not $ FileEx f+      Just c' ->+        let flines  = fc_lines c'+            flines' = M.mapKeys (\k -> if k > n then k-1 else k)+                                (M.delete n flines)+            maxlinenum' | n <= fc_maxline c'  = fc_maxline c' - 1+                        | otherwise           = n - 1+            c'' = FC flines' maxlinenum'+            do_delete = do+              set_contents f c''+              is_valid+        in case M.lookup n flines of+          Nothing -> do_delete+          Just l' -> if l == l'+                       then do_delete+                       else assert_not $ FileEx f -set_contents :: String -> [Possibly B.ByteString] -> PatchCheck ()-set_contents f mss = PC (sc f mss)-sc :: String -> [Possibly B.ByteString] -> KnownState -> (KnownState,())-sc f mss (P ks nots) = (P (scl [] f mss ks) nots, ())-sc _ _ Inconsistent = (Inconsistent, ())-scl :: [Prop] -> String -> [Possibly B.ByteString] -> [Prop] -> [Prop]-scl olds f mss [] = FileLines f mss : olds-scl olds f mss (FileLines f' mss':ks)-    | f == f' = FileLines f mss : (olds++ks)-    | f /= f' = scl (FileLines f' mss':olds) f mss ks-scl olds f mss (k:ks) = scl (k:olds) f mss ks+set_contents :: String -> FileContents -> PatchCheck ()+set_contents f c = handle_inconsistent () $ do+    P ks nots <- get+    let ks' = FileLines f c : filter (not . is_file_lines_for f) ks+    put (P ks' nots)+  where is_file_lines_for file prop = case prop of +                                        FileLines f' _ -> file == f'+                                        _              -> False -file_contents :: String -> PatchCheck [Possibly B.ByteString]-file_contents f = PC fc-    where fc Inconsistent = (Inconsistent, [])-          fc (P ks nots) = (P ks nots, fic ks)-          fic (FileLines f' mss:_) | f == f' = mss+-- | Get (as much as we know about) the contents of a file in the current state.+--   Returns Nothing if the state is inconsistent.+file_contents :: String -> PatchCheck (Maybe FileContents)+file_contents f = handle_inconsistent Nothing $ do+      P ks _ <- get+      return (fic ks)+    where fic (FileLines f' c:_) | f == f' = Just c           fic (_:ks) = fic ks-          fic [] = repeat PNothing+          fic [] = Just empty_filecontents -file_empty :: String -> PatchCheck Bool+-- | Checks if a file is empty+file_empty :: String          -- ^ Name of the file to check+           -> PatchCheck Bool file_empty f = do   c <- file_contents f-  let empty = all (PNothing ==) $ take 101 c+  let empty = case c of+               Just c' -> fc_maxline c' == 0 && M.null (fc_lines c')+               Nothing -> True   if empty-     then do set_contents f []+     then do set_contents f empty_filecontents              is_valid      -- Crude way to make it inconsistent and return false:      else assert_not $ FileEx f@@ -151,47 +181,72 @@          then d'          else f +-- | Replaces a filename by another in all paths. Returns True if the repository+--   is consistent, False if it is not. do_swap :: String -> String -> PatchCheck Bool-do_swap f f' = PC swfn-  where swfn Inconsistent = (Inconsistent, False)-        swfn (P ks nots) = (P (map sw ks) (map sw nots), True)-        sw (FileEx a) | f  `is_soe` a = FileEx $ movedirfilename f f' a+do_swap f f' = handle_inconsistent False $ do+    modify (\(P ks nots) -> P (map sw ks) (map sw nots))+    return True+  where sw (FileEx a) | f  `is_soe` a = FileEx $ movedirfilename f f' a                       | f' `is_soe` a = FileEx $ movedirfilename f' f a         sw (DirEx a) | f  `is_soe` a = DirEx $ movedirfilename f f' a                      | f' `is_soe` a = DirEx $ movedirfilename f' f a-        sw (FileLines a ls) | f  `is_soe` a = FileLines (movedirfilename f f' a) ls-                            | f' `is_soe` a = FileLines (movedirfilename f' f a) ls+        sw (FileLines a c) | f  `is_soe` a = FileLines (movedirfilename f f' a) c+                           | f' `is_soe` a = FileLines (movedirfilename f' f a) c         sw (NotEx a) | f `is_soe` a = NotEx $ movedirfilename f f' a                      | f' `is_soe` a = NotEx $ movedirfilename f' f a         sw p = p         is_soe d1 d2 = -- is_superdir_or_equal             d1 == d2 || (d1 ++ "/") `isPrefixOf` d2 +-- | Assert a property about the repository. If the property is already present+-- in the repo state, nothing changes, and the function returns True. If it is+-- not present yet, it is added to the repo state, and the function is True. If+-- the property is already in the list of properties that do not hold for the+-- repo, the state becomes inconsistent, and the function returns false. assert :: Prop -> PatchCheck Bool-assert p = PC assertfn-    where assertfn Inconsistent = (Inconsistent, False)-          assertfn (P ks nots) =-              if has p nots then (Inconsistent, False)-              else if has p ks then (P ks nots, True)-              else (P (p:ks) nots, True)+assert p = handle_inconsistent False $ do+    P ks nots <- get+    if has p nots+      then do+        put Inconsistent+        return False+      else if has p ks+             then return True+             else do+               put (P (p:ks) nots)+               return True +-- | Like @assert@, but negatively: state that some property must not hold for+--   the current repo. assert_not :: Prop -> PatchCheck Bool-assert_not p = PC assertnfn-    where assertnfn Inconsistent = (Inconsistent, False)-          assertnfn (P ks nots) =-              if has p ks then (Inconsistent, False)-              else if has p nots then (P ks nots, True)-              else (P ks (p:nots), True)+assert_not p = handle_inconsistent False $ do+    P ks nots <- get+    if has p ks+      then do+        put Inconsistent+        return False+      else if has p nots+             then return True+             else do+               put (P ks (p:nots))+               return True +-- | Remove a property from the list of properties that do not hold for this+-- repo (if it's there), and add it to the list of properties that hold.+-- Returns False if the repo is inconsistent, True otherwise. change_to_true :: Prop -> PatchCheck Bool-change_to_true p = PC chtfn-    where chtfn Inconsistent = (Inconsistent, False)-          chtfn (P ks nots) = (P (p:ks) (filter (p /=) nots), True)+change_to_true p = handle_inconsistent False $ do+    modify (\(P ks nots) -> P (p:ks) (filter (p /=) nots))+    return True +-- | Remove a property from the list of properties that hold for this repo (if+-- it's in there), and add it to the list of properties that do not hold.+-- Returns False if the repo is inconsistent, True otherwise. change_to_false :: Prop -> PatchCheck Bool-change_to_false p = PC chffn-    where chffn Inconsistent = (Inconsistent, False)-          chffn (P ks nots) = (P (filter (p /=) ks) (p:nots), True)+change_to_false p = handle_inconsistent False $ do+    modify (\(P ks nots) -> P (filter (p /=) ks) (p:nots))+    return True  assert_file_exists :: String -> PatchCheck Bool assert_file_exists f = do assert_not $ NotEx f@@ -249,25 +304,25 @@   do_swap f f'  substuff_dont_exist :: String -> PatchCheck Bool-substuff_dont_exist d = PC ssde-    where ssde Inconsistent = (Inconsistent, False)-          ssde (P ks nots) = if all noss ks-                             then (P ks nots, True)-                             else (Inconsistent, False)-              where noss (FileEx f) = not (is_within_dir f)-                    noss (DirEx f) = not (is_within_dir f)-                    noss _ = True-                    is_within_dir f = (d ++ "/") `isPrefixOf` f+substuff_dont_exist d = handle_inconsistent False $ do+    P ks _ <- get+    if all noss ks+      then return True+      else do+        put Inconsistent+        return False+  where noss (FileEx f) = not (is_within_dir f)+        noss (DirEx f) = not (is_within_dir f)+        noss _ = True+        is_within_dir f = (d ++ "/") `isPrefixOf` f +-- the init and tail calls dump the final init (which is just the path itself+-- again), the first init (which is empty), and the initial "." from+-- splitDirectories superdirs_exist :: String -> PatchCheck Bool-superdirs_exist fn =-  case matchRegex (mkRegex "\\./(.+)/[^/]+") fn of-  Just ["."] -> return True-  Just [d] -> do-                a <- assert_dir_exists ("./"++d)-                b <- superdirs_exist ("./"++d)-                return $! a && b-  _ -> is_valid+superdirs_exist fn = and `fmap` mapM assert_dir_exists superdirs+  where superdirs =  map (("./"++) . joinPath) +                         (init (tail (inits (tail (splitDirectories fn)))))  file_exists :: String -> PatchCheck Bool file_exists fn = do
src/Darcs/Patch/Core.lhs view
@@ -38,11 +38,10 @@        where  import Prelude hiding ( pi )-import Darcs.Patch.FileName ( fn2fp, fp2fn, norm_path ) import Darcs.Patch.Info ( PatchInfo, patchinfo, make_filename ) import Darcs.Patch.Patchy ( Patchy ) import Darcs.Ordered-import Darcs.Patch.Prim ( Prim(..), FromPrim(..), Effect(effect, effectRL) )+import Darcs.Patch.Prim ( Prim(..), FromPrim(..), Effect(effect, effectRL), n_fn ) #include "impossible.h"  data Patch C(x y) where@@ -127,9 +126,6 @@  patchcontents :: Named p C(x y) -> p C(x y) patchcontents (NamedP _ _ p) = p--n_fn :: FilePath -> FilePath-n_fn f = "./"++(fn2fp $ norm_path $ fp2fn f) \end{code}  The simplest relationship between two patches is that of ``sequential''
src/Darcs/Patch/Depends.hs view
@@ -31,7 +31,7 @@                ) where import Data.List ( delete, intersect ) import Control.Monad ( liftM2 )-import Control.Monad.Error (Error(..), MonadError(..))+import Control.Monad.Error ( Error(..) )  import Darcs.Patch ( RepoPatch, Named, getdeps, commutex,                      commuteFL,@@ -298,7 +298,7 @@                          $$ human_friendly (info $ n2pia hpc)       where ep = case hopefullyM hp of                  Right p' -> return p'-                 Left e -> throwError (MissingPatch (info hp) e)+                 Left e -> Left (MissingPatch (info hp) e)  missingPatchError :: MissingPatch -> a missingPatchError (MissingPatch pinfo e) =
src/Darcs/Patch/FileName.hs view
@@ -68,12 +68,24 @@ ps2fn :: B.ByteString -> FileName ps2fn ps = FN $ decode_white $ unpackPSfromUTF8 ps +-- | 'encode_white' translates whitespace in filenames to a darcs-specific+--   format (backslash followed by numerical representation according to 'ord').+--   Note that backslashes are also escaped since they are used in the encoding.+--+--   > encode_white "hello there" == "hello\32there"+--   > encode_white "hello\there" == "hello\\there" encode_white :: FilePath -> String encode_white (c:cs) | isSpace c || c == '\\' =     '\\' : (show $ ord c) ++ "\\" ++ encode_white cs encode_white (c:cs) = c : encode_white cs encode_white [] = [] +-- | 'decode_white' interprets the Darcs-specific \"encoded\" filenames+--   produced by 'encode_white'+--+--   > decode_white "hello\32there" == "hello there"+--   > decode_white "hello\\there"  == "hello\there"+--   > decode_white "hello\there"   == error "malformed filename" decode_white :: String -> FilePath decode_white ('\\':cs) =     case break (=='\\') cs of
src/Darcs/Patch/Match.lhs view
@@ -138,7 +138,18 @@ darcs changes --from-match 'date "Sat Jun  30 11:31:30 EDT 2004"' \end{verbatim} -Notes: when matching on the ISO format, a partial date is treated as a range.+Only English date specifications are supported---specifically you must use+English day and month names.  Also, only a limited set of time zones is+supported (compatible with GNU coreutils' date parsing).  Unrecognized zones+are treated as UTC, which may result in the timestamps printed in change+entries not being recognized by the date matching.  You can avoid this problem+on a POSIX-like system by running darcs in the UTC zone to get the times+initially, e.g.:+\begin{verbatim}+TZ=UTC darcs changes+\end{verbatim}++When matching on the ISO format, a partial date is treated as a range. English dates can either refer to a specific day (``6 months ago',``day before yesterday''), or to an interval from some past date (``last month'') to the present.  Putting this all@@ -254,6 +265,11 @@    "complement (not), conjunction (and) and disjunction (or) operators.",    "The C notation for logic operators (!, && and ||) can also be used.",    "",+   " --patches=regex is a synonym for --matches='name regex'", +   " --from-patch and --to-patch are synonyms for --from-match='name... and --to-match='name...",+   " --from-patch and --to-match can be unproblematically combined:",+   " darcs changes --from-patch='html.*documentation' --to-match='date 20040212'",+   "",    "The following primitive Boolean expressions are supported:"]   ++ keywords   ++ ["", "Here are some examples:"]@@ -276,6 +292,8 @@             ++ "'" ++ keyword ++ " " ++ example ++ "'"  primitiveMatchers :: Patchy p => [(String, String, [String], String -> MatchFun p)]+                     -- ^ keyword (operator), help description, list+                     -- of examples, matcher function primitiveMatchers =  [ ("exact", "check a literal string against the patch name"            , ["\"Resolve issue17: use dynamic memory allocation.\""]
src/Darcs/Patch/Non.hs view
@@ -80,8 +80,10 @@ data Non p C(x) where     Non :: FL p C(a x) -> Prim C(x y) -> Non p C(a) +-- | Convenience type for non primitive patches type NonPatch C(x) = Non Prim C(x) +-- | Return as a list the context followed by the primitive patch. unNon :: FromPrim p => Non p C(x) -> Sealed (FL p C(x)) unNon (Non c x) = Sealed (c +>+ fromPrim x :>: NilFL)
src/Darcs/Patch/Permutations.hs view
@@ -120,6 +120,8 @@           rc ms (_:nss) = rc ms nss           rc _ [] = impossible -- because we already checked for NilFL case +-- | 'removeFL' @x xs@ removes @x@ from @xs@ if @x@ can be commuted to its head.+--   Otherwise it returns 'Nothing' removeFL :: (MyEq p, Commute p) => p C(x y) -> FL p C(x z) -> Maybe (FL p C(y z)) removeFL x xs = r x $ headPermutationsFL xs     where r :: (MyEq p, Commute p) => p C(x y) -> [(p:>FL p) C(x z)] -> Maybe (FL p C(y z))@@ -127,6 +129,7 @@           r z ((z':>zs):zss) | IsEq <- z =\/= z' = Just zs                              | otherwise = r z zss +-- | 'removeRL' is like 'removeFL' except with 'RL' removeRL :: (MyEq p, Commute p) => p C(y z) -> RL p C(x z) -> Maybe (RL p C(x y)) removeRL x xs = r x $ head_permutationsRL xs     where r :: (MyEq p, Commute p) => p C(y z) -> [RL p C(x z)] -> Maybe (RL p C(x y))@@ -134,6 +137,10 @@                               | otherwise = r z zss           r _ _ = Nothing +-- | 'remove_subsequenceFL' @ab abc@ returns @Just c'@ where all the patches in+--   @ab@ have been commuted out of it, if possible.  If this is not possible+--   for any reason (the set of patches @ab@ is not actually a subset of @abc@,+--   or they can't be commuted out) we return 'Nothing'. remove_subsequenceFL :: (MyEq p, Commute p) => FL p C(a b)                      -> FL p C(a c) -> Maybe (FL p C(b c)) remove_subsequenceFL a b | lengthFL a > lengthFL b = Nothing@@ -142,6 +149,8 @@           rsFL NilFL ys = Just ys           rsFL (x:>:xs) yys = removeFL x yys >>= remove_subsequenceFL xs +-- | 'remove_subsequenceRL' is like @remove_subsequenceFL@ except that it works+--   on 'RL' remove_subsequenceRL :: (MyEq p, Commute p) => RL p C(ab abc)                      -> RL p C(a abc) -> Maybe (RL p C(a ab)) remove_subsequenceRL a b | lengthRL a > lengthRL b = Nothing@@ -150,9 +159,27 @@           rsRL NilRL ys = Just ys           rsRL (x:<:xs) yys = removeRL x yys >>= remove_subsequenceRL xs +-- | This is a minor variant of 'headPermutationsFL' with each permutation+--   is simply returned as a 'FL' head_permutationsFL :: Commute p => FL p C(x y) -> [FL p C(x y)] head_permutationsFL ps = map (\ (x:>xs) -> x:>:xs) $ headPermutationsFL ps +-- | 'headPermutationsFL' @p:>:ps@ returns all the permutations of the list+--   in which one element of @ps@ is commuted past @p@+--+--   Suppose we have a sequence of patches+--+--   >  X h a y s-t-c k+--+--   Suppose furthermore that the patch @c@ depends on @t@, which in turn+--   depends on @s@.  This function will return+--+--   > X :> h a y s t c k+--   > h :> X a y s t c k+--   > a :> X h y s t c k+--   > y :> X h a s t c k+--   > s :> X h a y t c k+--   > k :> X h a y s t c headPermutationsFL :: Commute p => FL p C(x y) -> [(p :> FL p) C(x y)] headPermutationsFL NilFL = [] headPermutationsFL (p:>:ps) =@@ -160,6 +187,9 @@         where swapfirstFL (p1:>p2:>xs) = do p2':>p1' <- commute (p1:>p2)                                             Just $ p2':>p1':>:xs +-- | 'head_permutationsRL' is like 'headPermutationsFL', except that we+--   operate on an 'RL' (in other words, we are pushing things to the end of a+--   patch sequence instead of to the beginning). head_permutationsRL :: Commute p => RL p C(x y) -> [RL p C(x y)] head_permutationsRL NilRL = [] head_permutationsRL (p:<:ps) =
src/Darcs/Patch/Prim.lhs view
@@ -15,9 +15,6 @@ %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, %  Boston, MA 02110-1301, USA. --\section{Patch relationships}- \begin{code} {-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}@@ -38,8 +35,9 @@          is_similar, is_adddir, is_filepatch,          canonize, try_to_shrink, modernizePrim,          subcommutes, sort_coalesceFL, join,-         applyBinary, try_tok_internal,+         try_tok_internal,          try_shrinking_inverse,+         n_fn,          FromPrim(..), FromPrims(..), ToFromPrim(..),          Conflict(..), Effect(..), commute_no_conflictsFL, commute_no_conflictsRL        )@@ -62,7 +60,6 @@ import Darcs.Sealed ( Sealed, unseal ) import Darcs.Patch.Patchy ( Invert(..), Commute(..) ) import Darcs.Patch.Permutations () -- for Invert instance of FL-import Darcs.SlurpDirectory ( FileContents ) import Darcs.Show import Darcs.Utils ( nubsort ) import Lcs ( getChanges )@@ -173,49 +170,7 @@  n_fn :: FilePath -> FilePath n_fn f = "./"++(fn2fp $ norm_path $ fp2fn f)-\end{code} -The simplest relationship between two patches is that of ``sequential''-patches, which means that the context of the second patch (the one on the-left) consists of the first patch (on the right) plus the context of the-first patch.  The composition of two patches (which is also a patch) refers-to the patch which is formed by first applying one and then the other.  The-composition of two patches, $P_1$ and $P_2$ is represented as $P_2P_1$,-where $P_1$ is to be applied first, then $P_2$\footnote{This notation is-inspired by the notation of matrix multiplication or the application of-operators upon a Hilbert space.  In the algebra of patches, there is-multiplication (i.e.\ composition), which is associative but not-commutative, but no addition or subtraction.}--There is one other very useful relationship that two patches can have,-which is to be parallel patches, which means that the two patches have an-identical context (i.e.\ their representation applies to identical trees).-This is represented by $P_1\parallel P_2$.  Of course, two patches may also-have no simple relationship to one another.  In that case, if you want to-do something with them, you'll have to manipulate them with respect to-other patches until they are either in sequence or in parallel.--The most fundamental and simple property of patches is that they must be-invertible.  The inverse of a patch is described by: $P^{ -1}$.  In the-darcs implementation, the inverse is required to be computable from-knowledge of the patch only, without knowledge of its context, but that-(although convenient) is not required by the theory of patches.-\begin{dfn}-The inverse of patch $P$ is $P^{ -1}$, which is the ``simplest'' patch for-which the composition \( P^{ -1} P \) makes no changes to the tree.-\end{dfn}-Using this definition, it is trivial to prove the following theorem-relating to the inverse of a composition of two patches.-\begin{thm} The inverse of the composition of two patches is-\[ (P_2 P_1)^{ -1} = P_1^{ -1} P_2^{ -1}. \]-\end{thm}-Moreover, it is possible to show that the right inverse of a patch is equal-to its left inverse.  In this respect, patches continue to be analogous to-square matrices, and indeed the proofs relating to these properties of the-inverse are entirely analogous to the proofs in the case of matrix-multiplication.  The compositions proofs can also readily be extended to-the composition of more than two patches.-\begin{code} instance Invert Prim where     invert Identity = Identity     invert (FP f RmFile)  = FP f AddFile@@ -445,17 +400,7 @@ showSplit x ps = blueText "("             $$ vcat (mapFL (showPrim x) ps)             $$ blueText ")"-\end{code} --\section{Commuting patches}--\subsection{Composite patches}--Composite patches are made up of a series of patches intended to be applied-sequentially.  They are represented by a list of patches, with the first-patch in the list being applied first.-\begin{code} commute_split :: CommuteFunction commute_split (Split patches :< patch) =     toPerhaps $ cs (patches :< patch) >>= sc@@ -597,55 +542,7 @@                                                 push_coalesce_patch p' r                                      Left r -> Left (p' :>: r)                                  Nothing -> Left (new:>:ps)-\end{code} -\newcommand{\commutex}{\longleftrightarrow}-\newcommand{\commutes}{\longleftrightarrow}--The first way (of only two) to change the context of a patch is by-commutation, which is the process of changing the order of two sequential-patches.-\begin{dfn}-The commutation of patches $P_1$ and $P_2$ is represented by-\[ P_2 P_1 \commutes {P_1}' {P_2}'. \]-Here $P_1'$ is intended to describe the same change as $P_1$, with the-only difference being that $P_1'$ is applied after $P_2'$ rather than-before $P_2$.-\end{dfn}-The above definition is obviously rather vague, the reason being that what-is the ``same change'' has not been defined, and we simply assume (and-hope) that the code's view of what is the ``same change'' will match those-of its human users.  The `$\commutes$' operator should be read as something-like the $==$ operator in C, indicating that the right hand side performs-identical changes to the left hand side, but the two patches are in-reversed order.  When read in this manner, it is clear that commutation-must be a reversible process, and indeed this means that commutation-\emph{can} fail, and must fail in certain cases.  For example, the creation-and deletion of the same file cannot be commuted.  When two patches fail to-commutex, it is said that the second patch depends on the first, meaning-that it must have the first patch in its context (remembering that the-context of a patch is a set of patches, which is how we represent a tree).-\footnote{The fact that commutation can fail makes a huge difference in the-whole patch formalism.  It may be possible to create a formalism in which-commutation always succeeds, with the result of what would otherwise be a-commutation that fails being something like a virtual particle (which can-violate conservation of energy), and it may be that such a formalism would-allow strict mathematical proofs (whereas those used in the current-formalism are mostly only hand waving ``physicist'' proofs).  However, I'm-not sure how you'd deal with a request to delete a file that has not yet-been created, for example.  Obviously you'd need to create some kind of-antifile, which would annihilate with the file when that file finally got-created, but I'm not entirely sure how I'd go about doing this.-$\ddot\frown$ So I'm sticking with my hand waving formalism.}--%I should add that one using the inversion relationship of sequential-%patches, one can avoid having to provide redundant definitions of-%commutation.--% There is another interesting property which is that a commutex's results-% can't be affected by commuting another thingamabopper.--\begin{code} is_in_directory :: FileName -> FileName -> Bool is_in_directory d f = iid (fn2fp d) (fn2fp f)     where iid (cd:cds) (cf:cfs)@@ -795,59 +692,7 @@      ("commute_filepatches", clever_commute commute_filepatches),      ("commutex", toPerhaps . commutex)     ]-\end{code} -\paragraph{Merge}-\newcommand{\merge}{\Longrightarrow}-The second way one can change the context of a patch is by a {\bf merge}-operation.  A merge is an operation that takes two parallel patches and-gives a pair of sequential patches.  The merge operation is represented by-the arrow ``\( \merge \)''.-\begin{dfn}\label{merge_dfn}-The result of a merge of two patches, $P_1$ and $P_2$ is one of two patches,-$P_1'$ and $P_2'$, which satisfy the relationship:-\[  P_2 \parallel P_1 \merge {P_2}' P_1 \commutex {P_1}' P_2. \]-\end{dfn}-Note that the sequential patches resulting from a merge are \emph{required}-to commutex.  This is an important consideration, as without it most of the-manipulations we would like to perform would not be possible.  The other-important fact is that a merge \emph{cannot fail}.  Naively, those two-requirements seem contradictory.  In reality, what it means is that the-result of a merge may be a patch which is much more complex than any we-have yet considered\footnote{Alas, I don't know how to prove that the two-constraints even \emph{can} be satisfied.  The best I have been able to do-is to believe that they can be satisfied, and to be unable to find an case-in which my implementation fails to satisfy them.  These two requirements-are the foundation of the entire theory of patches (have you been counting-how many foundations it has?).}.--\subsection{How merges are actually performed}--The constraint that any two compatible patches (patches which can-successfully be applied to the same tree) can be merged is actually quite-difficult to apply.  The above merge constraints also imply that the result-of a series of merges must be independent of the order of the merges.  So-I'm putting a whole section here for the interested to see what algorithms-I use to actually perform the merges (as this is pretty close to being the-most difficult part of the code).--The first case is that in which the two merges don't actually conflict, but-don't trivially merge either (e.g.\ hunk patches on the same file, where the-line number has to be shifted as they are merged).  This kind of merge can-actually be very elegantly dealt with using only commutation and inversion.--There is a handy little theorem which is immensely useful when trying to-merge two patches.-\begin{thm}\label{merge_thm}-$ P_2' P_1 \commutex P_1' P_2 $ if and only if $ P_1'^{ -1}-P_2' \commutex P_2 P_1^{ -1} $, provided both commutations succeed.  If-either commutex fails, this theorem does not apply.-\end{thm}-This can easily be proven by multiplying both sides of the first-commutation by $P_1'^{ -1}$ on the left, and by $P_1^{ -1}$ on the right.--\begin{code}- elegant_merge :: (Prim :\/: Prim) C(x y)               -> Maybe ((Prim :/\: Prim) C(x y)) elegant_merge (p1 :\/: p2) =@@ -898,7 +743,9 @@ coalesce (p :< Split NilFL) = Just p coalesce (Move a b :< Move b' a') | a == a' = Just $ Move b' b coalesce (Move a b :< FP f AddFile) | f == a = Just $ FP b AddFile+coalesce (Move a b :< DP f AddDir) | f == a = Just $ DP b AddDir coalesce (FP f RmFile :< Move a b) | b == f = Just $ FP a RmFile+coalesce (DP f RmDir :< Move a b) | b == f = Just $ DP a RmDir coalesce (ChangePref p f1 t1 :< ChangePref p2 f2 t2) | p == p2 && t2 == f1 = Just $ ChangePref p f2 t1 coalesce _ = Nothing @@ -1045,11 +892,6 @@ make_holey f line changes =     unsafeMap_l2f (\ (l,o,n) -> FP f (Hunk (l+line) o n)) changes         -applyBinary :: B.ByteString -> B.ByteString-            -> FileContents -> Maybe FileContents-applyBinary o n c | c == o = Just n-applyBinary _ _ _ = Nothing- try_tok_replace :: String -> String -> String                 -> [B.ByteString] -> Maybe [B.ByteString] try_tok_replace t o n mss =@@ -1161,6 +1003,40 @@         nubsort $ concatMap (unseal list_touched_files) $ concat $ resolve_conflicts p     resolve_conflicts :: p C(x y) -> [[Sealed (FL Prim C(y))]]     resolve_conflicts _ = []+    -- | If 'commute_no_conflicts' @x :> y@ succeeds, we know that that @x@ commutes+    --   past @y@ without any conflicts.   This function is useful for patch types+    --   for which 'commute' is defined to always succeed; so we need some way to+    --   pick out the specific cases where commutation succeeds without any conflicts.+    --+    --   Consider the commute square with patch names written in capital letters and+    --   repository states written in small letters.+    --+    --   @+    --          X+    --       o-->--a+    --       |     |+    --    Y' v     v Y+    --       |     |+    --       z-->--b+    --          X'+    --   @+    --+    --   The default definition of this function checks that we can mirror the+    --   commutation with patch inverses (written with the negative sign)+    --+    --   @+    --         -X     X+    --       a-->--o-->--a+    --       |     |     |+    --   Y'' v  Y' v     v Y+    --       |     |     |+    --       b-->--z-->--b+    --         (-X)'  X'+    --   @+    --+    --+    --   We check that commuting @X@ and @Y@ succeeds, as does commuting @-X@ and @Y'@.+    --   It also checks that @Y'' == Y@ and that @-(X')@ is the same as @(-X)'@     commute_no_conflicts :: (p :> p) C(x y) -> Maybe ((p :> p) C(x y))     commute_no_conflicts (x:>y) =         do y':>x' <- commute (x:>y)@@ -1203,6 +1079,10 @@     IsC :: !ConflictState -> !(Prim C(x y)) -> IsConflictedPrim data ConflictState = Okay | Conflicted | Duplicated deriving ( Eq, Ord, Show, Read) +-- | Patches whose concrete effect which can be expressed as a list of+--   primitive patches.+--+--   A minimal definition would be either of @effect@ or @effectRL@. class Effect p where     effect :: p C(x y) -> FL Prim C(x y)     effect = reverseRL . effectRL
src/Darcs/Patch/Real.hs view
@@ -85,11 +85,13 @@     Conflictor :: [Non RealPatch C(x)] -> FL Prim C(x y) -> Non RealPatch C(x) -> RealPatch C(y x)     InvConflictor :: [Non RealPatch C(x)] -> FL Prim C(x y) -> Non RealPatch C(x) -> RealPatch C(x y) +-- | 'is_duplicate' @p@ is ' @True@ if @p@ is either a  'Duplicate' or 'Etacilpud' patch is_duplicate :: RealPatch C(s y) -> Bool is_duplicate (Duplicate _) = True is_duplicate (Etacilpud _) = True is_duplicate _ = False +-- | This is only used for unit testing is_forward :: RealPatch C(s y) -> Maybe Doc is_forward p@(InvConflictor _ _ _) =     Just $ redText "An inverse conflictor" $$ showPatch p@@ -111,6 +113,8 @@           mergeUnravelled_private xs = reverseFL `fmap` mergeConflictingNons                                                         (map sealed2non $ filter notNullS xs) +-- | 'sealed2non' @(Sealed xs)@ converts @xs@ to a 'Non'.+--   @xs@ must be non-empty since we split this list at the last patch sealed2non :: Sealed ((FL Prim) C(x)) -> Non RealPatch C(x) sealed2non (Sealed xs) = case reverseFL xs of                          y:<:ys -> Non (mapFL_FL fromPrim $ reverseRL ys) y@@ -222,11 +226,15 @@ xx2patches :: [Non RealPatch C(x)] -> FL Prim C(x y) -> FL RealPatch C(x y) xx2patches ix xx = snd $ geteff ix xx +-- | If @xs@ consists only of 'Normal' patches, 'allNormal' @xs@ returns+--   @Just pxs@ those patches (so @lengthFL pxs == lengthFL xs@).+--   Otherwise, it returns 'Nothing'. allNormal :: FL RealPatch C(x y) -> Maybe (FL Prim C(x y)) allNormal (Normal x:>:xs) = (x :>:) `fmap` allNormal xs allNormal NilFL = Just NilFL allNormal _ = Nothing +-- | This is used for unit-testing and for internal sanity checks is_consistent :: RealPatch C(x y) -> Maybe Doc is_consistent (Normal _) = Nothing is_consistent (Duplicate _) = Nothing@@ -648,6 +656,9 @@ invertCommuteNC :: (RealPatch :> RealPatch) C(x y) -> Maybe ((RealPatch :> RealPatch) C(x y)) invertCommuteNC (x :> y) = do ix' :> iy' <- commute_no_conflicts (invert y :> invert x)                               return (invert iy' :> invert ix')++-- | 'pullCommon' @xs ys@ returns the set of patches that can be commuted+--   out of both @xs@ and @ys@ along with the remnants of both lists pullCommon :: Patchy p => FL p C(o x) -> FL p C(o y) -> Common p C(o x y) pullCommon NilFL ys = Common NilFL NilFL ys pullCommon xs NilFL = Common NilFL xs NilFL@@ -657,9 +668,13 @@                          xs1:>x':>xs2 -> case pullCommon xs1 ys of                                          Common c xs1' ys' -> Common c (xs1'+>+x':>:xs2) ys' +-- | 'Common' @cs xs ys@ represents two sequences of patches that have @cs@ in common,+--   in other words @cs +>+ xs@ and @cs +>+ ys@ data Common p C(o x y) where     Common :: FL p C(o i) -> FL p C(i x) -> FL p C(i y) -> Common p C(o x y) +-- | 'pullCommonRL' @xs ys@ returns the set of patches that can be commuted+--   out of both @xs@ and @ys@ along with the remnants of both lists pullCommonRL :: Patchy p => RL p C(x o) -> RL p C(y o) -> CommonRL p C(x y o) pullCommonRL NilRL ys = CommonRL NilRL ys NilRL pullCommonRL xs NilRL = CommonRL xs NilRL NilRL@@ -671,6 +686,8 @@     xs1:>x':>xs2 -> case pullCommonRL xs2 ys of                     CommonRL xs2' ys' c -> CommonRL (xs2'+<+x':<:xs1) ys' c +-- | 'CommonRL' @xs ys cs@' represents two sequences of patches that have @cs@ in common,+--   in other words @xs +<+ cs@ and @ys +<+ cs@ data CommonRL p C(x y f) where     CommonRL :: RL p C(x i) -> RL p C(y i) -> RL p C(i f) -> CommonRL p C(x y f)
src/Darcs/Patch/Show.lhs view
@@ -17,7 +17,7 @@   \begin{code}-{-# OPTIONS_GHC -cpp -fno-warn-orphans #-}+{-# OPTIONS_GHC -cpp -fno-warn-orphans -fglasgow-exts #-} {-# LANGUAGE CPP #-}  module Darcs.Patch.Show ( showPatch_, showNamedPrefix )
src/Darcs/RepoPath.hs view
@@ -18,26 +18,45 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -module Darcs.RepoPath ( AbsolutePath, makeAbsolute, ioAbsolute, rootDirectory,-                        SubPath, makeSubPathOf, simpleSubPath,-                        AbsolutePathOrStd,-                        makeAbsoluteOrStd, ioAbsoluteOrStd, useAbsoluteOrStd,-                        AbsoluteOrRemotePath, ioAbsoluteOrRemote, isRemote,-                        sp2fn,-                        FilePathOrURL(..), FilePathLike(toFilePath),-                        getCurrentDirectory, setCurrentDirectory-                      ) where+-- | Various abstractions for dealing with paths.+module Darcs.RepoPath (+  -- * AbsolutePath+  AbsolutePath,+  makeAbsolute,+  ioAbsolute,+  rootDirectory,+  -- * AbsolutePathOrStd+  AbsolutePathOrStd,+  makeAbsoluteOrStd,+  ioAbsoluteOrStd,+  useAbsoluteOrStd,+  -- * AbsoluteOrRemotePath+  AbsoluteOrRemotePath,+  ioAbsoluteOrRemote,+  isRemote,+  -- * SubPath+  SubPath,+  makeSubPathOf,+  simpleSubPath,+  -- * Miscellaneous+  sp2fn,+  FilePathOrURL(..),+  FilePathLike(toFilePath),+  getCurrentDirectory,+  setCurrentDirectory+) where  import Data.List ( isPrefixOf, isSuffixOf ) import Control.Exception ( bracket )  import Darcs.URL ( is_absolute, is_relative, is_ssh_nopath )-import Autoconf ( path_separator ) import qualified Workaround ( getCurrentDirectory ) import qualified System.Directory ( setCurrentDirectory ) import System.Directory ( doesDirectoryExist )-import qualified System.FilePath.Posix as FilePath+import qualified System.FilePath.Posix as FilePath ( normalise )+import qualified System.FilePath as NativeFilePath ( takeFileName, takeDirectory ) import qualified Darcs.Patch.FileName as PatchFileName ( FileName, fp2fn, fn2fp )+#include "impossible.h"  class FilePathOrURL a where  {-# INLINE toPath #-}@@ -47,10 +66,15 @@  {-# INLINE toFilePath #-}  toFilePath :: a -> FilePath --- | Relative to the local darcs repository and normalized---   Note: these are understood not to have the dot in front+-- | Paths which are relative to the local darcs repository and normalized.+-- Note: These are understood not to have the dot in front. newtype SubPath      = SubPath FilePath deriving (Eq, Ord)+ newtype AbsolutePath = AbsolutePath FilePath deriving (Eq, Ord)++-- | This is for situations where a string (e.g. a command line argument)+-- may take the value \"-\" to mean stdin or stdout (which one depends on+-- context) instead of a normal file path. data AbsolutePathOrStd = AP AbsolutePath | APStd deriving (Eq, Ord) data AbsoluteOrRemotePath = AbsP AbsolutePath | RmtP String deriving (Eq, Ord) @@ -94,10 +118,11 @@     else Nothing  simpleSubPath :: FilePath -> Maybe SubPath-simpleSubPath x | is_relative x = Just $ SubPath $ FilePath.normalise $ map cleanup x+simpleSubPath x | null x = bug "simpleSubPath called with empty path"+                | is_relative x = Just $ SubPath $ FilePath.normalise $ pathToPosix x                 | otherwise = Nothing --- | Interpret a possibly relative path wrt the current working directory+-- | Interpret a possibly relative path wrt the current working directory. ioAbsolute :: FilePath -> IO AbsolutePath ioAbsolute dir =     do isdir <- doesDirectoryExist dir@@ -106,21 +131,33 @@          then bracket (setCurrentDirectory dir)                       (const $ setCurrentDirectory $ toFilePath here)                       (const getCurrentDirectory)-         else let super_dir = case FilePath.takeDirectory dir of+         else let super_dir = case NativeFilePath.takeDirectory dir of                                 "" ->  "."                                 d  -> d-                  file = FilePath.takeFileName dir-              in do abs_dir <- ioAbsolute super_dir+                  file = NativeFilePath.takeFileName dir+              in do abs_dir <- if dir == super_dir+                               then return $ AbsolutePath dir+                               else ioAbsolute super_dir                     return $ makeAbsolute abs_dir file +-- | Take an absolute path and a string representing a (possibly relative)+-- path and combine them into an absolute path. If the second argument is+-- already absolute, then the first argument gets ignored. This function also+-- takes care that the result is converted to Posix convention and+-- normalized. Also, parent directories (\"..\") at the front of the string+-- argument get canceled out against trailing directory parts of the+-- absolute path argument.+--+-- Regarding the last point, someone more familiar with how these functions+-- are used should verify that this is indeed necessary or at least useful. makeAbsolute :: AbsolutePath -> FilePath -> AbsolutePath-makeAbsolute a dir = if is_absolute dir-                     then AbsolutePath $-                          slashes ++ FilePath.normalise cleandir-                     else ma a $ FilePath.normalise cleandir+makeAbsolute a dir = if not (null dir) && is_absolute dir+                     then AbsolutePath (norm_slashes dir')+                     else ma a dir'   where-    cleandir  = map cleanup dir-    slashes = norm_slashes $ takeWhile (== '/') cleandir+    dir' = FilePath.normalise $ pathToPosix dir+    -- Why do we care to reduce ".." here?+    -- Why not do this throughout the whole path, i.e. "x/y/../z" -> "x/z" ?     ma here ('.':'.':'/':r) = ma (takeDirectory here) r     ma here ".." = takeDirectory here     ma here "." = here@@ -132,10 +169,12 @@ (AbsolutePath "/") /- r = AbsolutePath ('/':simpleClean r) (AbsolutePath x) /- r = AbsolutePath (x++'/':simpleClean r) +-- | Convert to posix, remove trailing slashes, and (under Posix)+-- reduce multiple leading slashes to one. simpleClean :: String -> String-simpleClean x = norm_slashes $ reverse $ dropWhile (=='/') $ reverse $-                map cleanup x+simpleClean = norm_slashes . reverse . dropWhile (=='/') . reverse . pathToPosix +-- | The root directory as an absolute path. rootDirectory :: AbsolutePath rootDirectory = AbsolutePath "/" @@ -147,6 +186,8 @@ ioAbsoluteOrStd "-" = return APStd ioAbsoluteOrStd p = AP `fmap` ioAbsolute p +-- | Execute either the first or the second argument action, depending on+-- whether the given path is an 'AbsolutePath' or stdin/stdout. useAbsoluteOrStd :: (AbsolutePath -> IO a) -> IO a -> AbsolutePathOrStd -> IO a useAbsoluteOrStd _ f APStd = f useAbsoluteOrStd f _ (AP x) = f x@@ -182,13 +223,19 @@     show (AbsP a) = show a     show (RmtP r) = show r -cleanup :: Char -> Char-cleanup '\\' | path_separator == '\\' = '/'-cleanup c = c+-- | Normalize the path separator to Posix style (slash, not backslash).+-- This only affects Windows systems.+pathToPosix :: FilePath -> FilePath+pathToPosix = map convert where+#ifdef WIN32+  convert '\\' = '/'+#endif+  convert c = c -norm_slashes :: String -> String+-- | Reduce multiple leading slashes to one. This only affects Posix systems.+norm_slashes :: FilePath -> FilePath #ifndef WIN32--- multiple slashes in front are ignored under Unix+-- multiple slashes in front are ignored under Posix norm_slashes ('/':p) = '/' : dropWhile (== '/') p #endif norm_slashes p = p
src/Darcs/Repository.hs view
@@ -27,11 +27,11 @@                           withRepository, withRepositoryDirectory, withGutsOf,                           makePatchLazy, writePatchSet,                     findRepository, amInRepository, amNotInRepository,-                    slurp_pending, replacePristine, replacePristineFromSlurpy,+                    slurp_pending, replacePristineFromSlurpy,                     slurp_recorded, slurp_recorded_and_unrecorded,                     withRecorded,                     get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,-                    get_unrecorded_in_files,+                    get_unrecorded_in_files, get_unrecorded_in_files_unsorted,                     read_repo, sync_repo,                     prefsUrl,                     add_to_pending,@@ -59,11 +59,11 @@      maybeIdentifyRepository, identifyRepositoryFor,      findRepository, amInRepository, amNotInRepository,      makePatchLazy,-     slurp_pending, replacePristine, replacePristineFromSlurpy,+     slurp_pending, replacePristineFromSlurpy,      slurp_recorded, slurp_recorded_and_unrecorded,      withRecorded,      get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,-     get_unrecorded_in_files,+     get_unrecorded_in_files, get_unrecorded_in_files_unsorted,      read_repo, sync_repo,      prefsUrl, checkPristineAgainstSlurpy,      add_to_pending,@@ -105,7 +105,7 @@ import Darcs.Repository.Pristine ( createPristine, flagsToPristine ) import Darcs.Patch.Depends ( get_patches_beyond_tag ) import Darcs.SlurpDirectory ( empty_slurpy )-import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn )+import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn, prettyError ) import Darcs.External ( copyFileOrUrl, Cachable(..) ) import Progress ( debugMessage, tediousSize,                         beginTedious, endTedious, progress )@@ -209,7 +209,7 @@            FlippedSeal ps <- return $ get_patches_beyond_tag pi_ch local_patches            let needed_patches = reverseRL $ concatRL ps            apply opts ch `catch`-                             \e -> fail ("Bad checkpoint!\n" ++ show e)+                             \e -> fail ("Bad checkpoint!\n" ++ prettyError e)            apply_patches opts needed_patches            debugMessage "Writing the pristine"            pristineFromWorking torepository
src/Darcs/Repository/Cache.hs view
@@ -10,7 +10,8 @@                    unionCaches, cleanCaches, cleanCachesWithHint,                    fetchFileUsingCache, speculateFileUsingCache, writeFileUsingCache,                    findFileMtimeUsingCache, setFileMtimeUsingCache, peekInCache,-                   repo2cache+                   repo2cache,+                   writable, isthisrepo, hashedFilePath, allHashedDirs                  ) where  import Control.Monad ( liftM, when, guard )@@ -48,6 +49,9 @@ hashedDir HashedPatchesDir = "patches" hashedDir HashedInventoriesDir = "inventories" +allHashedDirs :: [HashedDir]+allHashedDirs = [HashedPristineDir, HashedPatchesDir, HashedInventoriesDir]+ data WritableOrNot = Writable | NotWritable deriving ( Show ) data CacheType = Repo | Directory deriving ( Eq, Show ) data CacheLoc = Cache !CacheType !WritableOrNot !String@@ -115,6 +119,10 @@ writable :: CacheLoc -> Bool writable (Cache _ NotWritable _) = False writable (Cache _ Writable _) = True++isthisrepo :: CacheLoc -> Bool+isthisrepo (Cache Repo Writable _) = True+isthisrepo _ = False  -- | @hashedFilePath cachelocation subdir hash@ returns the physical filename of -- hash @hash@ in the @subdir@ section of @cachelocation@.
src/Darcs/Repository/DarcsRepo.lhs view
@@ -16,7 +16,6 @@ %  Boston, MA 02110-1301, USA.  \chapter{DarcsRepo format}-\label{repository_format}  A repository consists of a working directory, which has within it a directory called \verb!_darcs!. There must also be a subdirectory within@@ -257,7 +256,7 @@  read_repo_private :: RepoPatch p => String -> [DarcsFlag] -> FilePath -> FilePath -> IO (SealedPatchSet p) read_repo_private k opts d iname = do-    i <- fetchFilePS (d++"/"++darcsdir++"/"++iname) Uncachable+    i <- gzFetchFilePS (d++"/"++darcsdir++"/"++iname) Uncachable     finishedOneIO k iname     (rest,str) <- case BC.break ((==) '\n') i of                   (swt,pistr) | swt == BC.pack "Starting with tag:" ->
src/Darcs/Repository/HashedRepo.hs view
@@ -22,7 +22,7 @@ module Darcs.Repository.HashedRepo ( revert_tentative_changes, finalize_tentative_changes,                                      slurp_pristine, sync_repo, clean_pristine,                                      copy_pristine, copy_partials_pristine, pristine_from_working,-                                     apply_to_tentative_pristine, replacePristine,+                                     apply_to_tentative_pristine,                                      replacePristineFromSlurpy,                                      add_to_tentative_inventory, remove_from_tentative_inventory,                                      read_repo, read_tentative_repo, write_and_read_patch,@@ -208,15 +208,16 @@ write_and_read_patch :: RepoPatch p => Cache -> Compression -> PatchInfoAnd p C(x y)                      -> IO (PatchInfoAnd p C(x y)) write_and_read_patch c compr p = do (i,h) <- write_patch_if_necesary c compr p-                                    Sealed x <- createHashed h (parse i)-                                    return $ patchInfoAndPatch i $ unsafeCoerceP x-    where parse i h = do debugMessage ("Reading patch file: "++ show (human_friendly i))+                                    unsafeInterleaveIO $ readp h i+    where parse i h = do debugMessage ("Rereading patch file: "++ show (human_friendly i))                          (fn,ps) <- fetchFileUsingCache c HashedPatchesDir h                          case readPatch ps of                            Just (x,_) -> return x                            Nothing -> fail $ unlines ["Couldn't parse patch file "++fn,                                                       "which is",                                                       renderString $ human_friendly i]+          readp h i = do Sealed x <- createHashed h (parse i)+                         return $ patchInfoAndPatch i $ unsafeCoerceP x  write_tentative_inventory :: RepoPatch p => Cache -> Compression -> PatchSet p C(x) -> IO () write_tentative_inventory c compr = write_either_inventory c compr "tentative_hashed_inventory"@@ -262,9 +263,11 @@ write_patch_if_necesary :: RepoPatch p => Cache -> Compression                         -> PatchInfoAnd p C(x y) -> IO (PatchInfo, String) write_patch_if_necesary c compr hp =-    case extractHash hp of-    Right h -> return (info hp, h)-    Left p -> fmap (\h -> (info hp, h)) $ writeHashFile c compr HashedPatchesDir $ showPatch p+    seq infohp $ case extractHash hp of+                   Right h -> return (infohp, h)+                   Left p -> (\h -> (infohp, h)) `fmap`+                             writeHashFile c compr HashedPatchesDir (showPatch p)+    where infohp = info hp  pihash :: (PatchInfo,String) -> Doc pihash (pinf,hash) = showPatchInfo pinf $$ text ("hash: " ++ hash ++ "\n")@@ -336,11 +339,9 @@                                       | otherwise -> slurpHashedPristine c compr h  pristine_from_working :: Cache -> Compression -> IO ()-pristine_from_working c compr = replacePristine c compr "."--replacePristine :: Cache -> Compression -> FilePath -> IO ()-replacePristine c compr d = do s <- slurp_all_but_darcs d-                               replacePristineFromSlurpy c compr s+pristine_from_working c compr = do+  s <- slurp_all_but_darcs "."+  replacePristineFromSlurpy c compr s  replacePristineFromSlurpy :: Cache -> Compression -> Slurpy -> IO () replacePristineFromSlurpy c compr s = do
src/Darcs/Repository/Internal.hs view
@@ -26,10 +26,12 @@                     findRepository, amInRepository, amNotInRepository,                     slurp_pending, pristineFromWorking, revertRepositoryChanges,                     slurp_recorded, slurp_recorded_and_unrecorded,+                    read_pending, announce_merge_conflicts, setTentativePending,+                    check_unrecorded_conflicts,                     withRecorded,                     checkPristineAgainstSlurpy,                     get_unrecorded, get_unrecorded_unsorted, get_unrecorded_no_look_for_adds,-                    get_unrecorded_in_files,+                    get_unrecorded_in_files, get_unrecorded_in_files_unsorted,                     read_repo, sync_repo,                     prefsUrl, makePatchLazy,                     add_to_pending,@@ -42,7 +44,7 @@                     unrevertUrl,                     applyToWorking, patchSetToPatches,                     createPristineDirectoryTree, createPartialsPristineDirectoryTree,-                    replacePristine, replacePristineFromSlurpy,+                    replacePristineFromSlurpy,                     optimizeInventory, cleanRepository,                     getMarkedupFile,                     PatchSet, SealedPatchSet,@@ -64,8 +66,8 @@                                    easyCreatePristineDirectoryTree, slurpPristine, syncPristine,                                    easyCreatePartialsPristineDirectoryTree,                                    createPristineFromWorking )-import qualified Darcs.Repository.Pristine as Pristine ( replacePristine,-                                                         replacePristineFromSlurpy )+import qualified Darcs.Repository.Pristine as Pristine ( replacePristineFromSlurpy )+                                                          import Data.List ( (\\) ) import Darcs.SignalHandler ( withSignalsBlocked ) import Darcs.Repository.Format ( RepoFormat, RepoProperty( Darcs2, HashedInventory ),@@ -100,7 +102,7 @@                               write_tentative_inventory, write_and_read_patch,                               add_to_tentative_inventory,                               read_repo, read_tentative_repo, clean_pristine,-                              replacePristine, replacePristineFromSlurpy,+                              replacePristineFromSlurpy,                               slurp_all_but_darcs ) import qualified Darcs.Repository.DarcsRepo as DarcsRepo import Darcs.Flags ( DarcsFlag(AnyOrder, Boring, LookForAdds, Verbose, Quiet,@@ -394,11 +396,16 @@ get_unrecorded_no_look_for_adds r paths = get_unrecorded_private (filter (/= LookForAdds)) r paths   get_unrecorded_unsorted :: RepoPatch p => Repository p C(r u t) -> IO (FL Prim C(r u))-get_unrecorded_unsorted r = get_unrecorded_private (AnyOrder:) r []+get_unrecorded_unsorted r = get_unrecorded_in_files_unsorted r []  get_unrecorded :: RepoPatch p => Repository p C(r u t) -> IO (FL Prim C(r u)) get_unrecorded r = get_unrecorded_private id r [] +-- | Gets the unrecorded changes in the given paths in the current repository,+--   without sorting them for presentation to the user+get_unrecorded_in_files_unsorted :: RepoPatch p => Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r u))+get_unrecorded_in_files_unsorted = get_unrecorded_private (AnyOrder:)+ -- | Gets the unrecorded changes in the given paths in the current repository. get_unrecorded_in_files :: RepoPatch p => Repository p C(r u t) -> [FileName] -> IO (FL Prim C(r u)) get_unrecorded_in_files = get_unrecorded_private id @@ -923,6 +930,17 @@                         where isr = isJust $ hopefullyM x                  _ -> unrevert_impossible unrevert_loc +-- | Writes out a fresh copy of the inventory that minimizes the+-- amount of inventory that need be downloaded when people pull from+-- the repository.+--+-- Specifically, it breaks up the inventory on the most recent tag.+-- This speeds up most commands when run remotely, both because a+-- smaller file needs to be transfered (only the most recent+-- inventory).  It also gives a guarantee that all the patches prior+-- to a given tag are included in that tag, so less commutation and+-- history traversal is needed.  This latter issue can become very+-- important in large repositories. optimizeInventory :: RepoPatch p => Repository p C(r u t) -> IO () optimizeInventory repository@(Repo r opts rf (DarcsRepository _ c)) =     do ps <- read_repo repository@@ -939,11 +957,6 @@     HvsO { hashed = HashedRepo.clean_pristine repository,            old = return () } -replacePristine :: Repository p C(r u t) -> FilePath -> IO ()-replacePristine (Repo r opts rf (DarcsRepository pris c)) d-    | format_has HashedInventory rf = withCurrentDirectory r $ HashedRepo.replacePristine c (compression opts) d-    | otherwise = withCurrentDirectory r $ Pristine.replacePristine d pris- replacePristineFromSlurpy :: Repository p C(r u t) -> Slurpy -> IO () replacePristineFromSlurpy (Repo r opts rf (DarcsRepository pris c)) s     | format_has HashedInventory rf = withCurrentDirectory r $ HashedRepo.replacePristineFromSlurpy c (compression opts) s@@ -991,7 +1004,11 @@ checkPristineAgainstSlurpy repository@(Repo _ opts _ _) s2 =     do s1 <- slurp_recorded repository        ftf <- filetype_function-       return $ nullFL $ unsafeDiff (LookForAdds:IgnoreTimes:opts) ftf s1 s2+       -- The @$!@ is necessary because some code called from this function uses+       -- unsafeInterleaveIO around functions that throw exceptions. If one used+       -- @$@ instead of @$!@ here, those exceptions might not be caught by code+       -- that runs this function inside a @catch@.+       return $! nullFL $ unsafeDiff (LookForAdds:IgnoreTimes:opts) ftf s1 s2  withTentative :: forall p a C(r u t). RepoPatch p =>                  Repository p C(r u t) -> ((AbsolutePath -> IO a) -> IO a)
src/Darcs/Repository/Prefs.lhs view
@@ -23,25 +23,26 @@ #include "gadts.h"  module Darcs.Repository.Prefs ( add_to_preflist, get_preflist, set_preflist,-                   get_global,+                   get_global, environmentHelpHome,                    defaultrepo, set_defaultrepo,                    get_prefval, set_prefval, change_prefval,                    def_prefval,                    write_default_prefs,-                   boring_file_filter, darcsdir_filter,+                   boring_regexps, boring_file_filter, darcsdir_filter,                    FileType(..), filetype_function,                    getCaches,+                   binaries_file_help                  ) where  import System.IO.Error ( isDoesNotExistError ) import Control.Monad ( unless, when, mplus ) import Text.Regex ( Regex, mkRegex, matchRegex, ) import Data.Char ( toUpper )-import Data.Maybe ( isNothing, isJust, catMaybes )-import Data.List ( nub, isPrefixOf )-import System.Directory ( getAppUserDataDirectory, doesDirectoryExist )-import System.Environment( getEnv )+import Data.Maybe ( isJust, catMaybes )+import Data.List ( nub, isPrefixOf, union )+import System.Directory ( getAppUserDataDirectory ) import System.FilePath ( (</>) )+import System.Environment ( getEnvironment )  import Darcs.Flags ( DarcsFlag( NoCache, NoSetDefault, DryRun, Ephemeral, RemoteRepo ) ) import Darcs.RepoPath ( AbsolutePath, ioAbsolute, toFilePath, getCurrentDirectory )@@ -115,7 +116,8 @@ \verb!_darcs/prefs/boring!, so be sure to copy that file to the boringfile.  You can also set up a ``boring'' regexps-file in your home directory, named \verb!~/.darcs/boring!, which will be+file in your home directory, named \verb!~/.darcs/boring!, +on MS Windows~\ref{ms_win}, which will be used with all of your darcs repositories.  Any file not already managed by darcs and whose repository path (such@@ -237,16 +239,22 @@ is_darcsdir "../" = True is_darcsdir fp = darcsdir `isPrefixOf` fp +-- | The path of the global preference directory; @~/.darcs@ on Unix,+-- and @%APPDATA%/darcs@ on Windows. global_prefs_dir :: IO (Maybe FilePath) global_prefs_dir = do-  dir <- (</> ".darcs") `fmap` getEnv "DARCS_TESTING_HOME"-  exists <- doesDirectoryExist dir-  if exists then return $ Just dir-            else userDir- `catch` \_ -> userDir -- no such environment variable- where userDir = (getAppUserDataDirectory "darcs" >>= return.Just)-                   `catchall` (return Nothing)+  env <- getEnvironment+  case lookup "DARCS_TESTING_PREFS_DIR" env of+    Just d -> return (Just d)+    Nothing -> (getAppUserDataDirectory "darcs" >>= return.Just)+               `catchall` (return Nothing) +environmentHelpHome :: ([String], [String])+environmentHelpHome = (["HOME", "APPDATA"], [+ "Per-user preferences are set in $HOME/.darcs (on Unix) or",+ "%APPDATA%/darcs (on Windows).  This is also the default location of",+ "the cache."])+ get_global :: String -> IO [String] get_global f = do   dir <- global_prefs_dir@@ -258,13 +266,16 @@ global_cache_dir = slash_cache `fmap` global_prefs_dir   where slash_cache = fmap (</> "cache") -boring_file_filter :: IO ([FilePath] -> [FilePath])-boring_file_filter = do+boring_regexps :: IO [Regex]+boring_regexps = do     borefile <- def_prefval "boringfile" (darcsdir ++ "/prefs/boring")     bores <- get_lines borefile `catchall` return []     gbs <- get_global "boring"-    return $ actual_boring_file_filter $ map mkRegex (bores++gbs)+    return $ map mkRegex $ bores ++ gbs +boring_file_filter :: IO ([FilePath] -> [FilePath])+boring_file_filter = boring_regexps >>= return . actual_boring_file_filter+ noncomments :: [String] -> [String] noncomments ss = filter is_ok ss                  where is_ok "" = False@@ -283,12 +294,12 @@           nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False           nc _ = True +-- | From a list of paths, filter out any that are within @_darcs@ or+-- match a boring regexp. actual_boring_file_filter :: [Regex] -> [FilePath] -> [FilePath]-actual_boring_file_filter regexps fs =-    filter (abf (not.is_darcsdir) regexps . normalize) fs-    where-    abf fi (r:rs) = abf (\f -> fi f && isNothing (matchRegex r f)) rs-    abf fi [] = fi+actual_boring_file_filter regexps files = filter (not . boring . normalize) files+    where boring file = is_darcsdir file ||+                        any (\regexp -> isJust $ matchRegex regexp file) regexps  normalize :: FilePath -> FilePath normalize ('.':'/':f) = normalize f@@ -309,24 +320,37 @@ (e.g.\ \verb'darcs setpref binariesfile ./.binaries', where \verb'.binaries' is a file that has been darcs added to your repository).  As with the boring file, you can also set-up a \verb!~/.darcs/binaries! file if you like.+up a \verb!~/.darcs/binaries! file if you like, on MS Windows~\ref{ms_win}.  \begin{code} data FileType = BinaryFile | TextFile                 deriving (Eq)  {-# NOINLINE default_binaries #-}+-- | The lines that will be inserted into @_darcs/prefs/binaries@ when+-- @darcs init@ is run.  Hence, a list of comments, blank lines and+-- regular expressions (ERE dialect).+--+-- Note that while this matches .gz and .GZ, it will not match .gZ,+-- i.e. it is not truly case insensitive. default_binaries :: [String]-default_binaries =-    "# Binary file regexps:" :-    ext_regexes ["png","gz","pdf","jpg","jpeg","gif","tif",-                 "tiff","pnm","pbm","pgm","ppm","bmp","mng",-                 "tar","bz2","z","zip","jar","so","a",-                 "tgz","mpg","mpeg","iso","exe","doc",-                 "elc", "pyc"]-    where ext_regexes exts = concat $ map ext_regex exts-          ext_regex e = ["\\."++e++"$", "\\."++map toUpper e++"$"]+default_binaries = help +++                   ["\\.(" ++ e ++ "|" ++ map toUpper e ++ ")$" | e <- extensions ]+    where extensions = ["a","bmp","bz2","doc","elc","exe","gif","gz","iso",+                        "jar","jpe?g","mng","mpe?g","p[nbgp]m","pdf","png",+                        "pyc","so","tar","tgz","tiff?","z","zip"]+          help = map ("# "++) binaries_file_help +binaries_file_help :: [String]+binaries_file_help =+  ["This file contains a list of extended regular expressions, one per",+   "line.  A file path matching any of these expressions is assumed to",+   "contain binary data (not text).  The entries in ~/.darcs/binaries (if",+   "it exists) supplement those in this file.",+   "",+   "Blank lines, and lines beginning with an octothorpe (#) are ignored.",+   "See regex(7) for a description of extended regular expressions."]+ filetype_function :: IO (FilePath -> FileType) filetype_function = do     binsfile <- def_prefval "binariesfile" (darcsdir ++ "/prefs/binaries")@@ -356,7 +380,7 @@   hasprefs <- mDoesDirectoryExist $ fp2fn prefs   unless hasprefs $ mCreateDirectory $ fp2fn prefs   pl <- get_preflist p-  mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ add_to_list s pl+  mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ union [s] pl  get_preflist :: ReadableDirectory m => String -> m [String] get_preflist p = do prefs <- prefsDirectory `mplus` return "x"@@ -377,10 +401,6 @@      then mWriteBinFile (fp2fn $ prefs ++ p) (unlines ls)      else return () -add_to_list :: Eq a => a -> [a] -> [a]-add_to_list s [] = [s]-add_to_list s (s':ss) = if s == s' then (s:ss) else s': add_to_list s ss- def_prefval :: String -> String -> IO String def_prefval p d = do   pv <- get_prefval p@@ -477,6 +497,8 @@ repositories, so you may need to vary this.  You can also use multiple cache directories on different filesystems, if you have several filesystems on which you use darcs.++On MS Windows~\ref{ms_win})  \begin{code} getCaches :: [DarcsFlag] -> String -> IO Cache
src/Darcs/Repository/Pristine.hs view
@@ -25,7 +25,7 @@                  createPristine, removePristine, identifyPristine,                  slurpPristine,                  applyPristine, createPristineFromWorking,-                 syncPristine, replacePristine, replacePristineFromSlurpy,+                 syncPristine, replacePristineFromSlurpy,                  getPristinePop,                  pristineDirectory, pristineToFlagString,                  easyCreatePristineDirectoryTree,@@ -152,18 +152,6 @@        owork <- co_slurp ocur "."        sync n ocur owork syncPristine HashedPristine = return () -- FIXME this should be implemented!--replacePristine :: FilePath -> Pristine -> IO ()-replacePristine _ (NoPristine _) = return ()-replacePristine newcur (PlainPristine n) =-    do rm_recursive nold-           `catchall` return ()-       renameDirectory n nold-       renameDirectory newcur n-       return ()-           where nold = darcsdir ++ "/" ++ pristineName ++ "-old"-replacePristine _ HashedPristine =-    bug "HashedPristine is not implemented yet."  replacePristineFromSlurpy :: Slurpy -> Pristine -> IO () replacePristineFromSlurpy _ (NoPristine _) = return ()
src/Darcs/Repository/Repair.hs view
@@ -80,14 +80,15 @@           aaf s NilFL = return ([], s, True)           aaf s (p:>:ps) = do             (s', mp') <- run_slurpy s $ applyAndTryToFix p-            finishedOneIO k $ show $ human_friendly $ info p+            let !infp = info p -- assure that 'p' can be garbage collected.+            finishedOneIO k $ show $ human_friendly $ infp             s'' <- syncSlurpy (update_slurpy r c opts) s'             (ps', s''', restok) <- aaf s'' ps             case mp' of               Nothing -> return (ps', s''', restok)               Just (e,pp) -> do putStrLn e                                 p' <- makePatchLazy r pp-                                return ((info p, p'):ps', s''', False)+                                return ((infp, p'):ps', s''', False)  data RepositoryConsistency p =     RepositoryConsistent@@ -135,7 +136,7 @@                   (ps, s_, ok) <- applyAndFix c opts s repo psin                   debugMessage "Done fixing broken patches..."                   return (s_, (reverseFL ps :<: NilRL), ok)-  debugMessage "Checking pristine agains slurpy"+  debugMessage "Checking pristine against slurpy"   is_same <- checkPristineAgainstSlurpy repo s' `catchall` return False   -- TODO is the latter condition needed? Does a broken patch imply pristine   -- difference? Why, or why not?
src/Darcs/Resolution.lhs view
@@ -26,6 +26,7 @@                           patchset_conflict_resolutions,                         ) where +import System.FilePath.Posix ( (</>) ) import System.Exit ( ExitCode( ExitSuccess ) ) import System.Directory ( setCurrentDirectory, getCurrentDirectory ) import Data.List ( zip4 )@@ -141,7 +142,8 @@  Note that if you do use an external merge tool, most likely you will want to add to your defaults file-(\verb!_darcs/prefs/defaults! or \verb!~/.darcs/prefs!, see \ref{defaults})+(\verb!_darcs/prefs/defaults! or \verb!~/.darcs/prefs!, see \ref{defaults}, +on MS Windows~\ref{ms_win}) a line such as \begin{verbatim} ALL external-merge kdiff3 --output %o %a %1 %2@@ -201,7 +203,7 @@                         -> IO () externally_resolve_file c da d1 d2 dm (fa, f1, f2, fm) = do     putStrLn $ "Merging file "++fm++" by hand."-    ec <- run c [('1', d1///f1), ('2', d2///f2), ('a', da///fa), ('o', dm///fm), ('%', "%")]+    ec <- run c [('1', d1</>f1), ('2', d2</>f2), ('a', da</>fa), ('o', dm</>fm), ('%', "%")]     when (ec /= ExitSuccess) $          putStrLn $ "External merge command exited with " ++ show ec     askUser "Hit return to move on, ^C to abort the whole operation..."@@ -216,9 +218,6 @@                                             unwords (command:args) ++ "'"                                  exec command args (Null,Null,Null)           rr [] = return ExitSuccess--(///) :: FilePath -> FilePath -> FilePath-d /// f = d ++ "/" ++ f  patchset_conflict_resolutions :: RepoPatch p => PatchSet p C(x) -> Sealed (FL Prim C(x)) patchset_conflict_resolutions (NilRL:<:_) = --traceDoc (greenText "no conflicts A") $
src/Darcs/RunCommand.hs view
@@ -15,6 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +{-# LANGUAGE CPP #-} module Darcs.RunCommand ( run_the_command ) where  import Control.Monad ( unless, when )@@ -44,6 +45,10 @@                         extract_commands,                         super_name,                         subusage, chomp_newline )+#ifdef HAVE_HASKELL_ZLIB+import Darcs.Commands.GZCRCs ( doCRCWarnings )+import Darcs.Global ( atexit )+#endif import Darcs.Commands.Help ( command_control_list ) import Darcs.External ( viewDoc ) import Darcs.Global ( setDebugMode, setSshControlMasterDisabled,@@ -130,6 +135,9 @@                when (HTTPPipelining `elem` os) $ setHTTPPipelining True                when (NoHTTPPipelining `elem` os) $ setHTTPPipelining False                unless (SSHControlMaster `elem` os) setSshControlMasterDisabled+#ifdef HAVE_HASKELL_ZLIB+               unless (Quiet `elem` os) $ atexit $ doCRCWarnings (Verbose `elem` os)+#endif                -- actually run the command and its hooks                preHookExitCode <- run_prehook os here                if preHookExitCode /= ExitSuccess
src/Darcs/SelectChanges.hs view
@@ -36,21 +36,21 @@                      ) where import System.IO import Data.List ( intersperse )-import Data.Maybe ( catMaybes )+import Data.Maybe ( catMaybes, isJust ) import Data.Char ( toUpper ) import Control.Monad ( when ) import System.Exit ( exitWith, ExitCode(ExitSuccess) )  import English ( Noun(..), englishNum  )+import Darcs.Arguments ( showFriendly ) import Darcs.Hopefully ( PatchInfoAnd, hopefully ) import Darcs.Repository ( Repository, read_repo ) import Darcs.Patch ( RepoPatch, Patchy, Prim, summary,                      invert, list_touched_files,                      commuteFL )-import Darcs.Patch.Patchy ( showPatch ) import qualified Darcs.Patch ( thing, things ) import Darcs.Ordered ( FL(..), RL(..), (:>)(..),-                       (+>+), lengthFL, concatRL, mapFL_FL,+                       (+>+), lengthFL, lengthRL, concatRL, mapFL_FL,                        spanFL, reverseFL, (+<+), mapFL,                        unsafeCoerceP ) import Darcs.Patch.Choices ( PatchChoices, patch_choices, patch_choices_tps,@@ -66,11 +66,10 @@                     ) import Darcs.Patch.TouchesFiles ( deselect_not_touching, select_not_touching ) import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager )-import Darcs.SlurpDirectory ( Slurpy ) import Darcs.Match ( have_nonrange_match, match_a_patch, match_a_patchread ) import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies), isInteractive ) import Darcs.Sealed ( FlippedSeal(..), flipSeal, seal2, unseal2 )-import Darcs.Utils ( askUser, promptCharFancy, without_buffering )+import Darcs.Utils ( askUser, promptCharFancy ) import Printer ( prefix, putDocLn ) #include "impossible.h" @@ -81,7 +80,6 @@ type WithPatches p a C(x y) =         String              -- jobname      -> [DarcsFlag]         -- opts-     -> Slurpy              -- directory      -> FL p C(x y)         -- patches to select among      -> ((FL p :> FL p) C(x y) -> IO a) -- job      -> IO a                -- result of running job@@ -90,7 +88,6 @@ type WithPatchesToFiles p a C(x y) =         String              -- jobname      -> [DarcsFlag]         -- opts-     -> Slurpy              -- directory      -> [FilePath]          -- files      -> FL p C(x y)         -- patches to select among      -> ((FL p :> FL p) C(x y) -> IO a) -- job@@ -136,39 +133,34 @@  -- | wasc and wasc_ are just shorthand for with_any_selected_changes wasc  :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatches p a C(x y)-wasc mwch crit j o s = wasc_ mwch crit j o s []+wasc mwch crit j o = wasc_ mwch crit j o [] wasc_ :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y) wasc_ = with_any_selected_changes  with_any_selected_changes :: Patchy p => WhichChanges -> MatchCriterion p -> WithPatchesToFiles p a C(x y)-with_any_selected_changes Last crit jn opts s fs =+with_any_selected_changes Last crit jn opts fs =     with_any_selected_changes_last         (patches_to_consider_last' fs opts crit)-        crit jn opts s fs-with_any_selected_changes First crit jn opts s fs =+        crit jn opts fs+with_any_selected_changes First crit jn opts fs =     with_any_selected_changes_first        (patches_to_consider_first' fs opts crit)-       crit jn opts s fs-with_any_selected_changes FirstReversed crit jn opts s fs =+       crit jn opts fs+with_any_selected_changes FirstReversed crit jn opts fs =     with_any_selected_changes_first_reversed        (patches_to_consider_first_reversed' fs opts crit)-       crit jn opts s fs-with_any_selected_changes LastReversed crit jn opts s fs =+       crit jn opts fs+with_any_selected_changes LastReversed crit jn opts fs =     with_any_selected_changes_last_reversed         (patches_to_consider_last_reversed' fs opts crit)-        crit jn opts s fs+        crit jn opts fs  -view_changes :: RepoPatch p => [DarcsFlag] -> Slurpy -> [FilePath] -> FL (PatchInfoAnd p) C(x y) -> IO ()-view_changes opts _ fp ps =-  case patches_to_consider_nothing' fp opts iswanted ps of-  ps_to_consider :> _ -> vc ps_to_consider- where-       vc :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> IO ()-       vc p = without_buffering $ do text_view opts ps_len 0 NilRL init_tps init_pc-                                     return ()-        where (init_pc, init_tps) = patch_choices_tps p-              ps_len = lengthFL init_tps+view_changes :: RepoPatch p => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()+view_changes opts ps = do+  text_view opts Nothing 0 NilRL init_tps init_pc+  return ()+    where (init_pc, init_tps) = patch_choices_tps ps  data KeyPress a = KeyPress { kp     :: Char                            , kpHelp :: String }@@ -191,7 +183,7 @@                               -> (FORALL(a) (FL (PatchInfoAnd p) :> PatchInfoAnd p) C(a r) -> IO ()) -> IO () with_selected_patch_from_repo jn repository opts job = do     p_s <- read_repo repository-    sp <- without_buffering $ wspfr jn (match_a_patchread opts)+    sp <- wspfr jn (match_a_patchread opts)                               (concatRL p_s) NilFL     case sp of      Just (FlippedSeal (skipped :> selected)) -> job (skipped :> selected)@@ -240,13 +232,12 @@                                => (FL p C(x y) -> (FL p :> FL p) C(x y))                                -> MatchCriterion p                                -> WithPatchesToFiles p a C(x y)-with_any_selected_changes_last p2c crit jobname opts _ _ ps job =+with_any_selected_changes_last p2c crit jobname opts _ ps job =  case p2c ps of  ps_to_consider :> other_ps ->          if not $ isInteractive opts          then job $ ps_to_consider :> other_ps-         else do pc <- without_buffering $-                       tentatively_text_select "" jobname (Noun "patch") Last crit+         else do pc <- tentatively_text_select "" jobname (Noun "patch") Last crit                                               opts ps_len 0 NilRL init_tps init_pc                  job $ selected_patches_last rejected_ps pc          where rejected_ps = ps_to_consider@@ -257,13 +248,12 @@                                 => (FL p C(x y) -> (FL p :> FL p) C(x y))                                 -> MatchCriterion p                                 -> WithPatchesToFiles p a C(x y)-with_any_selected_changes_first p2c crit jobname opts _ _ ps job =+with_any_selected_changes_first p2c crit jobname opts _ ps job =  case p2c ps of  ps_to_consider :> other_ps ->          if not $ isInteractive opts          then job $ ps_to_consider :> other_ps-         else do pc <- without_buffering $-                       tentatively_text_select "" jobname (Noun "patch") First crit+         else do pc <- tentatively_text_select "" jobname (Noun "patch") First crit                                               opts ps_len 0 NilRL init_tps init_pc                  job $ selected_patches_first rejected_ps pc          where rejected_ps = other_ps@@ -274,13 +264,12 @@                                 => (FL p C(x y) -> (FL p :> FL p) C(y x))                                 -> MatchCriterion p                                 -> WithPatchesToFiles p a C(x y)-with_any_selected_changes_first_reversed p2c crit jobname opts _ _ ps job =+with_any_selected_changes_first_reversed p2c crit jobname opts _ ps job =  case p2c ps of  ps_to_consider :> other_ps ->          if not $ isInteractive opts          then job $ invert other_ps :> invert ps_to_consider-         else do pc <- without_buffering $-                       tentatively_text_select "" jobname (Noun "patch") FirstReversed crit+         else do pc <- tentatively_text_select "" jobname (Noun "patch") FirstReversed crit                                              opts ps_len 0 NilRL init_tps init_pc                  job $ selected_patches_first_reversed rejected_ps pc          where rejected_ps = ps_to_consider@@ -291,13 +280,12 @@                                 => (FL p C(x y) -> (FL p :> FL p) C(y x))                                 -> MatchCriterion p                                 -> WithPatchesToFiles p a C(x y)-with_any_selected_changes_last_reversed p2c crit jobname opts _ _ ps job =+with_any_selected_changes_last_reversed p2c crit jobname opts _ ps job =  case p2c ps of  ps_to_consider :> other_ps ->          if not $ isInteractive opts          then job $ invert other_ps :> invert ps_to_consider-         else do pc <- without_buffering $-                       tentatively_text_select "" jobname (Noun "patch") LastReversed crit+         else do pc <- tentatively_text_select "" jobname (Noun "patch") LastReversed crit                                              opts ps_len 0 NilRL init_tps init_pc                  job $ selected_patches_last_reversed rejected_ps pc          where rejected_ps = other_ps@@ -382,25 +370,6 @@     else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs                      $ deselect_unwanted $ patch_choices $ invert ps -patches_to_consider_nothing' :: RepoPatch p-                     => [FilePath]  -- ^ files-                     -> [DarcsFlag] -- ^ opts-                     -> MatchCriterion (PatchInfoAnd p)-                     -> FL (PatchInfoAnd p) C(x y) -- ^ patches-                     -> (FL (PatchInfoAnd p) :> FL (PatchInfoAnd p)) C(x y)-patches_to_consider_nothing' fs opts crit ps =-  let deselect_unwanted pc =-        if have_nonrange_match opts-        then if DontGrabDeps `elem` opts-             then force_matching_last (not.iswanted_) pc-             else make_everything_later $ force_matching_first iswanted_ pc-        else pc-      iswanted_ = crit First opts . tp_patch-  in if null fs && not (have_nonrange_match opts)-     then ps :> NilFL-     else tp_patches $ separate_first_middle_from_last $ deselect_not_touching fs-                     $ deselect_unwanted $ patch_choices ps- -- | Returns the results of a patch selection user interaction selected_patches_last :: Patchy p => FL p C(x y) -> PatchChoices p C(y z)                       -> (FL p :> FL p) C(x z)@@ -490,7 +459,7 @@                                                 then map_patches last_chs                                                 else map_patches first_chs                           map_patches = mapFL (\a ->-                                           showPatch `unseal2` (seal2 $ tp_patch a))+                                           (showFriendly opts) `unseal2` (seal2 $ tp_patch a))                       putStrLn $ "---- Already selected "++things++" ----"                       mapM_ putDocLn $ selected                       putStrLn $ "---- end of already selected "++things++" ----"@@ -540,7 +509,7 @@                      _ -> exitWith $ ExitSuccess             else return () -text_view :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> Int -> Int+text_view :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> Maybe Int -> Int             -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y u) -> PatchChoices p C(r s)             -> IO ((PatchChoices p) C(r s)) text_view _ _ _ _ NilFL _ = return $ patch_choices $ unsafeCoerceP NilFL --return pc@@ -575,13 +544,14 @@         options_nav =           [ KeyPress 'q' ("quit view changes")           , KeyPress 'k' "back up to previous patch"-          , KeyPress 'j' "skip to next patch" ]+          , KeyPress 'j' "skip to next patch"+          , KeyPress 'c' "count total patch number" ]         options = [ options_yn ]                   ++ [ options_view ++                        if Summary `elem` opts then [] else options_summary ]                   ++ [ options_nav ]         prompt = "Shall I view this patch? "-               ++ "(" ++ show (n+1) ++ "/" ++ show n_max ++ ")"+               ++ "(" ++ show (n+1) ++ "/" ++ maybe "?" show n_max ++ ")"         repeat_this :: IO ((PatchChoices p) C(r s))         repeat_this = do           yorn <- promptCharFancy prompt (keysFor options) (Just 'n') "?h"@@ -596,9 +566,11 @@             'k' -> prev_patch             'j' -> next_patch             'c' -> text_view opts-                       n_max n tps_done tps_todo pc+                       count_n_max n tps_done tps_todo pc             _   -> do putStrLn $ helpFor "view changes" options                       repeat_this+        count_n_max | isJust n_max = n_max+                    | otherwise    = Just $ lengthFL tps_todo + lengthRL tps_done tentatively_text_select :: Patchy p => String -> String -> Noun -> WhichChanges                         -> MatchCriterion p -> [DarcsFlag]                         -> Int -> Int -> RL (TaggedPatch p) C(x y) -> FL (TaggedPatch p) C(y z)
src/Darcs/Show.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -cpp #-}+{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}  module Darcs.Show(Show1(..), Show2(..), showOp2, app_prec) where
src/Darcs/SlurpDirectory/Internal.hs view
@@ -672,9 +672,6 @@ slurp_sync_size = 100 * 1000000  syncSlurpy :: (Slurpy -> IO Slurpy) -> Slurpy -> IO Slurpy-syncSlurpy put s = if (unsyncedSlurpySize s > slurp_sync_size)-                       then do-                          s' <- put s-                          return s'-                       else do-                          return s+syncSlurpy put s = if unsyncedSlurpySize s > slurp_sync_size+                   then put s+                   else return s
src/Darcs/TheCommands.hs view
@@ -15,6 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +{-# LANGUAGE CPP #-} module Darcs.TheCommands ( command_control_list ) where  import Darcs.Commands.Add ( add )@@ -26,11 +27,17 @@ import Darcs.Commands.Convert ( convert ) import Darcs.Commands.Diff import Darcs.Commands.Dist ( dist )-import Darcs.Commands.Get ( get )+import Darcs.Commands.Get ( get, clone )+#ifdef HAVE_HASKELL_ZLIB+import Darcs.Commands.GZCRCs ( gzcrcs )+#else+-- import just to check it compiles+import Darcs.Commands.GZCRCs ()+#endif import Darcs.Commands.Init ( initialize ) import Darcs.Commands.Show ( show_command, list, query ) import Darcs.Commands.MarkConflicts ( markconflicts, resolve )-import Darcs.Commands.Mv ( mv, move )+import Darcs.Commands.Move ( move, mv ) import Darcs.Commands.Optimize ( optimize ) import Darcs.Commands.Pull ( pull ) import Darcs.Commands.Push ( push )@@ -58,7 +65,7 @@ command_control_list = [Group_name "Changing and querying the working copy:",                 Command_data add,                 Command_data remove, Hidden_command unadd, Hidden_command rm,-                Command_data mv, Hidden_command move,+                Command_data move, Hidden_command mv,                 Command_data replace,                 Command_data revert,                 Command_data unrevert,@@ -86,11 +93,15 @@                 Command_data push,                 Command_data send,                 Command_data apply,-                Command_data get,+                Command_data get, Hidden_command clone,                 Command_data put,                 Group_name "Administrating repositories:",                 Command_data initialize,                 Command_data optimize,                 Command_data check,                 Command_data repair,-                Command_data convert]+                Command_data convert+#ifdef HAVE_HASKELL_ZLIB+                ,Hidden_command gzcrcs+#endif+               ]
src/Darcs/URL.hs view
@@ -60,6 +60,7 @@ is_relative "" = bug "Empty filename in is_relative"  is_absolute :: String -> Bool+is_absolute "" = bug "is_absolute called with empty filename" is_absolute f = is_file f && (not $ is_relative f)  is_file :: String -> Bool
src/Darcs/Utils.hs view
@@ -3,34 +3,29 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-}  module Darcs.Utils ( catchall, ortryrunning, nubsort, breakCommand,-                     clarify_errors, prettyException,+                     clarify_errors, prettyException, prettyError,                     putStrLnError, putDocLnError,                     withCurrentDirectory,                     withUMask, askUser, stripCr,                     showHexLen, add_to_error_loc,                     maybeGetEnv, firstNotBlank, firstJustM, firstJustIO,                     isUnsupportedOperationError, isHardwareFaultError,-                    get_viewer, edit_file, promptYorn, promptCharFancy, without_buffering,+                    get_viewer, edit_file, promptYorn, promptCharFancy,+                    environmentHelpEditor, environmentHelpPager,                     formatPath ) where  import Prelude hiding ( catch )-import Control.Exception ( bracket, bracket_, catch, Exception(IOException), throwIO, try, throw, ioErrors )-import Control.Concurrent ( newEmptyMVar, takeMVar, putMVar, forkIO )-#if !defined(WIN32) ||  __GLASGOW_HASKELL__>=609-import Control.Concurrent ( threadWaitRead )-#endif+import Control.Exception ( bracket, bracket_, catch, Exception(IOException), try ) import GHC.IOBase ( IOException(ioe_location),                     IOErrorType(UnsupportedOperation, HardwareFault) )-import System.IO.Error ( isUserError, ioeGetErrorType, ioeGetErrorString,-                         isEOFError )+import System.IO.Error ( isUserError, ioeGetErrorType, ioeGetErrorString )  import Darcs.SignalHandler ( catchNonSignal ) import Numeric ( showHex )-import System.Exit ( ExitCode(..) )+import System.Directory ( doesFileExist )+import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getEnv )-import System.IO ( hFlush, hPutStrLn, stderr, stdout, stdin,-                   BufferMode ( NoBuffering ),-                   hLookAhead, hReady, hSetBuffering, hGetBuffering, hIsTerminalDevice )+import System.IO ( hPutStrLn, stderr ) import Data.Char ( toUpper ) import Darcs.RepoPath ( FilePathLike, getCurrentDirectory, setCurrentDirectory, toFilePath ) import Data.Maybe ( listToMaybe, isJust )@@ -44,13 +39,11 @@  import Progress ( withoutProgress ) -#ifdef HAVE_HASKELINE-import System.Console.Haskeline ( runInputT, defaultSettings, getInputLine )-#endif--#ifdef WIN32-import System.Posix.Internals ( getEcho, setCooked, setEcho )-#endif+import System.Console.Haskeline ( runInputT, defaultSettings, getInputLine,+                                  getInputChar, outputStrLn )+import System.Console.Haskeline.Encoding ( encode )+import qualified Data.ByteString as B ( readFile )+import qualified Data.ByteString.Char8 as B ( unpack )  showHexLen :: (Integral a) => Int -> a -> String showHexLen n x = let s = showHex x ""@@ -105,11 +98,23 @@ prettyException (IOException e) | isUserError e = ioeGetErrorString e prettyException e = show e +prettyError :: IOError -> String+prettyError e | isUserError e = ioeGetErrorString e+              | otherwise = show e++-- | Given two shell commands as arguments, execute the former.  The+-- latter is then executed if the former failed because the executable+-- wasn't found (code 127), wasn't executable (code 126) or some other+-- exception occurred.  Other failures (such as the user holding ^C)+-- do not cause the second command to be tried. ortryrunning :: IO ExitCode -> IO ExitCode -> IO ExitCode-a `ortryrunning` b = do ret <- try a-                        case ret of-                          (Right ExitSuccess) -> return ExitSuccess-                          _ -> b+a `ortryrunning` b = do+  ret <- try a+  case ret of+    (Right (ExitFailure 126)) -> b -- command not executable+    (Right (ExitFailure 127)) -> b -- command not found+    (Right x) -> return x          -- legitimate success/failure+    (Left _) -> b                  -- an exception  putStrLnError :: String -> IO () putStrLnError = hPutStrLn stderr@@ -140,41 +145,13 @@            (reset_umask rc)            job --- withThread is used to allow ctrl-C to work even while we're waiting for--- user input.  The job is run in a separate thread, and any exceptions it--- produces are re-thrown in the parent thread.-withThread :: IO a -> IO a-withThread j = do m <- newEmptyMVar-                  forkIO (runJob m)-                  takeMVar m >>= either throwIO return-    where runJob m = (j >>= putMVar m . Right) `catch` (putMVar m . Left)- askUser :: String -> IO String-#ifdef HAVE_HASKELINE-askUser prompt = withoutProgress $ runInputT defaultSettings (getInputLine prompt)+askUser prompt = withoutProgress $ runInputT defaultSettings $+                    getInputLine prompt                         >>= maybe (error "askUser: unexpected end of input") return-                                      -#else-askUser prompt = withThread $ withoutProgress $ do putStr prompt-                                                   hFlush stdout-                                                   waitForStdin-#ifndef WIN32-                                                   getLine-#else-                                                   stripCr `fmap` getLine-#endif-#endif--waitForStdin :: IO ()-#ifdef WIN32-#if __GLASGOW_HASKELL__ >= 609-waitForStdin = threadWaitRead 0-#else-waitForStdin = return ()  -- threadWaitRead didn't work prior to 6.9-#endif-#else-waitForStdin = threadWaitRead 0-#endif+            -- Return the input as encoded, 8-bit Chars (same as the+            -- non-Haskeline backend).+                        >>= fmap B.unpack . encode  stripCr :: String -> String stripCr ""     = ""@@ -207,109 +184,75 @@  edit_file :: FilePathLike p => p -> IO ExitCode edit_file ff = do-  let f = toFilePath ff   ed <- get_editor-  exec_interactive ed f+  old_content <- file_content+  ec <- exec_interactive ed f              `ortryrunning` exec_interactive "emacs" f              `ortryrunning` exec_interactive "emacs -nw" f              `ortryrunning` exec_interactive "nano" f #ifdef WIN32              `ortryrunning` exec_interactive "edit" f #endif+  new_content <- file_content+  when (new_content == old_content) $ do+    yorn <- promptYorn "File content did not change. Continue anyway?"+    when (yorn == 'n') $ do putStrLn "Aborted."+                            exitWith ExitSuccess+  return ec+      where f = toFilePath ff+            file_content = do+              exists <- doesFileExist f+              if exists then do content <- B.readFile f+                                return $ Just content+                        else return Nothing+ get_editor :: IO String get_editor = getEnv "DARCS_EDITOR" `catchall`              getEnv "DARCSEDITOR" `catchall`              getEnv "VISUAL" `catchall`              getEnv "EDITOR" `catchall` return "vi" +environmentHelpEditor :: ([String], [String])+environmentHelpEditor = (["DARCS_EDITOR", "DARCSEDITOR", "VISUAL", "EDITOR"],[+ "To edit a patch description of email comment, Darcs will invoke an",+ "external editor.  Your preferred editor can be set as any of the",+ "environment variables $DARCS_EDITOR, $DARCSEDITOR, $VISUAL or $EDITOR.",+ "If none of these are set, vi(1) is used.  If vi crashes or is not",+ "found in your PATH, emacs, emacs -nw, nano and (on Windows) edit are",+ "each tried in turn."])+ get_viewer :: IO String get_viewer = getEnv "DARCS_PAGER" `catchall`              getEnv "PAGER" `catchall` return "less" +environmentHelpPager :: ([String], [String])+environmentHelpPager = (["DARCS_PAGER", "PAGER"],[+ "Darcs will sometimes invoke a pager if it deems output to be too long",+ "to fit onscreen.  Darcs will use the pager specified by $DARCS_PAGER",+ "or $PAGER.  If neither are set, `less' will be used."])+ promptYorn :: [Char] -> IO Char promptYorn p = promptCharFancy p "yn" Nothing []  promptCharFancy :: String -> [Char] -> Maybe Char -> [Char] -> IO Char-promptCharFancy p chs md help_chs =- do a <- withThread $ without_buffering $-           do putStr $ p ++ " ["++ setDefault chs ++"]" ++ helpStr-              hFlush stdout-              waitForStdin-              c <- getChar-#ifdef WIN32-              -- We need to simulate echo-              e <- get_raw_mode-              when e $ putChar c-#endif-              return c-    when (a /= '\n') $ putStr "\n" +promptCharFancy p chs md help_chs = withoutProgress $ runInputT defaultSettings $+                                        loopChar+ where+ loopChar = do+    let prompt = p ++ " [" ++ setDefault chs ++ "]" ++ helpStr+    a <- getInputChar prompt >>= maybe (error "promptCharFancy: unexpected end of input")+                                    return     case () of       _ | a `elem` chs                   -> return a        | a == ' ' -> case md of Nothing -> tryAgain                                  Just d  -> return d        | a `elem` help_chs              -> return a        | otherwise                      -> tryAgain- where   helpStr = case help_chs of            []    -> ""            (h:_) -> ", or " ++ (h:" for help: ")- tryAgain = do putStrLn "Invalid response, try again!"-               promptCharFancy p chs md help_chs+ tryAgain = do outputStrLn "Invalid response, try again!"+               loopChar  setDefault s = case md of Nothing -> s                            Just d  -> map (setUpper d) s  setUpper d c = if d == c then toUpper c else c--without_buffering :: IO a -> IO a-without_buffering job = withoutProgress $ do-    bracket nobuf rebuf $ \_ -> job-    where nobuf = do is_term <- hIsTerminalDevice stdin-                     bi <- hGetBuffering stdin-                     raw <- get_raw_mode-                     when is_term $ do hSetBuffering stdin NoBuffering `catch` \_ -> return ()-                                       set_raw_mode True-                     return (bi,raw)-          rebuf (bi,raw) = do is_term <- hIsTerminalDevice stdin-#if SYS == windows-                              buffers <- hGetBuffering stdin-                              hSetBuffering stdin NoBuffering `catch` \_ -> return ()-                              drop_returns-                              hSetBuffering stdin buffers `catch` \_ -> return ()-#else-                              drop_returns-#endif-                              when is_term $ do hSetBuffering stdin bi `catch` \_ -> return ()-                                                set_raw_mode raw-          drop_returns = do is_ready <- hReady stdin `catch` \ e ->-                                        case ioErrors e of-                                          Just x -> if isEOFError x-                                                      then return True-                                                      else throw e-                                          _ -> throw e-                            when is_ready $-                              do waitForStdin-                                 c <- hLookAhead stdin `catch` \_ -> return ' '-                                 when (c == '\n') $-                                   do getChar-                                      drop_returns---- Code which was in the module RawMode before. Moved here to break cyclic imports-#ifdef WIN32--get_raw_mode :: IO Bool-get_raw_mode = not `fmap` getEcho 0-  `catchall` return False -- getEcho sometimes fails when called from scripts--set_raw_mode :: Bool -> IO ()-set_raw_mode raw = (setCooked 0 normal >> setEcho 0 normal)-   `catchall` return () -- setCooked sometimes fails when called from scripts- where normal = not raw--#else--get_raw_mode :: IO Bool-get_raw_mode = return False--set_raw_mode :: Bool -> IO ()-set_raw_mode _ = return ()--#endif
src/English.hs view
@@ -15,18 +15,25 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +-- | This modules provides rudimentary natural language generation+-- (NLG) utilities.  That is, generating natural language from a+-- machine representation.  Initially, only English is supported at+-- all.  Representations are implemented for:+--+--  * countable nouns (plurality); and+--  * lists of clauses (foo, bar and/or baz). module English where -import Data.List (isSuffixOf)+import Data.List (isSuffixOf, intersperse)  -- | > englishNum 0 (Noun "watch") "" == "watches" --   > englishNum 1 (Noun "watch") "" == "watch" --   > englishNum 2 (Noun "watch") "" == "watches"-englishNum :: Numbered n => Int -> n -> ShowS+englishNum :: Countable n => Int -> n -> ShowS englishNum x = if x == 1 then singular else plural  -- | Things that have a plural and singular spelling-class Numbered a where+class Countable a where   plural :: a -> ShowS   singular :: a -> ShowS @@ -39,7 +46,7 @@ --   > plural (Noun "mouse") "" == "mouses" -- :-( newtype Noun = Noun String -instance Numbered Noun where+instance Countable Noun where   -- more irregular nouns will just need to have their own type   plural (Noun s) | "ch" `isSuffixOf` s = showString s .  showString "es"   plural (Noun s) = showString s . showChar 's'@@ -49,6 +56,21 @@ --   > plural   This (Noun "batch") "" == "these batches" data This = This Noun -instance Numbered This where+instance Countable This where   plural (This s)   = showString "these "  . plural s   singular (This s) = showString "this "   . singular s++-- | Given a list of things, combine them thusly:+--+--   > orClauses ["foo", "bar", "baz"] == "foo, bar or baz"+andClauses, orClauses :: [String] -> String+andClauses = intersperseLast ", " " and "+orClauses  = intersperseLast ", " " or "++-- | As 'intersperse', with a different separator for the last+-- | interspersal.+intersperseLast :: String -> String -> [String] -> String+intersperseLast _ _ [] = ""+intersperseLast _ _ [clause] = clause+intersperseLast sep sepLast clauses =+    concat (intersperse sep $ init clauses) ++ sepLast ++ last clauses
src/HTTP.hs view
@@ -38,7 +38,7 @@     Just uri -> do debugMessage $ "Fetching over HTTP:  "++url                    proxy <- getProxy                    when (not $ null proxy) $-                     debugFail "No proxy support for HTTP package yet (try libcurl or libwww)!"+                     debugFail "No proxy support for HTTP package yet (try libcurl)!"                    resp <- simpleHTTP $ Request { rqURI = uri,                                                   rqMethod = GET,                                                   rqHeaders = headers,@@ -54,7 +54,7 @@     Just uri -> do debugMessage $ "Posting to HTTP:  "++url                    proxy <- getProxy                    when (not $ null proxy) $-                     debugFail "No proxy support for HTTP package yet (try libcurl or libwww)!"+                     debugFail "No proxy support for HTTP package yet (try libcurl)!"                    resp <- simpleHTTP $ Request { rqURI = uri,                                                   rqMethod = POST,                                                   rqHeaders = headers ++ [Header HdrContentType mime,
src/IsoDate.hs view
@@ -33,6 +33,7 @@ import Data.Char ( toUpper, isDigit ) import Data.Maybe ( fromMaybe ) import Control.Monad ( liftM, liftM2 )+import qualified Data.ByteString.Char8 as B  type TimeInterval = (Maybe CalendarTime, Maybe CalendarTime) @@ -73,18 +74,20 @@ --   understood are those of 'showIsoDateTime' and 'date_time' parseDate :: Int -> String -> Either ParseError MCalendarTime parseDate tz d =-              if length d >= 14 && and (map isDigit $ take 14 d)+              if length d >= 14 && B.all isDigit bd               then Right $ toMCalendarTime $-                   CalendarTime (read $ take 4 d)-                                (toEnum $ (+ (-1)) $ read $ take 2 $ drop 4 d)-                                (read $ take 2 $ drop 6 d) -- Day-                                (read $ take 2 $ drop 8 d) -- Hour-                                (read $ take 2 $ drop 10 d) -- Minute-                                (read $ take 2 $ drop 12 d) -- Second+                   CalendarTime (readI $ B.take 4 bd)+                                (toEnum $ (+ (-1)) $ readI $ B.take 2 $ B.drop 4 bd)+                                (readI $ B.take 2 $ B.drop 6 bd) -- Day+                                (readI $ B.take 2 $ B.drop 8 bd) -- Hour+                                (readI $ B.take 2 $ B.drop 10 bd) -- Minute+                                (readI $ B.take 2 $ B.drop 12 bd) -- Second                                 0 Sunday 0 -- Picosecond, weekday and day of year unknown                                 "GMT" 0 False               else let dt = do { x <- date_time tz; eof; return x }                    in parse dt "" d+  where bd = B.pack (take 14 d)+        readI s = fst $ fromMaybe (error "parseDate: invalid date") (B.readInt s)  -- | Display a 'CalendarTime' in the ISO 8601 format without any --   separators, e.g. 20080825142503@@ -472,9 +475,8 @@ -- --   * Universal timezones: UTC, UT -----   * Some American timezones: EST, EDT, CST, CDT, MST, MDT, PST, PDT------   * Some European timezones: UT, GMT, CEST, EEST+--   * Zones from GNU coreutils/lib/getdate.y, less half-hour ones --+--     sorry Newfies. -- --   * any sequence of alphabetic characters (WARNING! treated as 0!) zone            :: CharParser a Int@@ -484,6 +486,16 @@                        , mkZone "UTC"  0                        , mkZone "UT"  0                        , mkZone "GMT" 0+                       , mkZone "WET" 0+                       , mkZone "WEST" 1+                       , mkZone "BST" 1+                       , mkZone "ART" (-3)+                       , mkZone "BRT" (-3)+                       , mkZone "BRST" (-2)+                       , mkZone "AST" (-4)+                       , mkZone "ADT" (-3)+                       , mkZone "CLT" (-4)+                       , mkZone "CLST" (-3)                        , mkZone "EST" (-5)                        , mkZone "EDT" (-4)                        , mkZone "CST" (-6)@@ -492,8 +504,32 @@                        , mkZone "MDT" (-6)                        , mkZone "PST" (-8)                        , mkZone "PDT" (-7)+                       , mkZone "AKST" (-9)+                       , mkZone "AKDT" (-8)+                       , mkZone "HST" (-10)+                       , mkZone "HAST" (-10)+                       , mkZone "HADT" (-9)+                       , mkZone "SST" (-12)+                       , mkZone "WAT" 1+                       , mkZone "CET" 1                        , mkZone "CEST" 2+                       , mkZone "MET" 1+                       , mkZone "MEZ" 1+                       , mkZone "MEST" 2+                       , mkZone "MESZ" 2+                       , mkZone "EET" 2                        , mkZone "EEST" 3+                       , mkZone "CAT" 2+                       , mkZone "SAST" 2+                       , mkZone "EAT" 3+                       , mkZone "MSK" 3+                       , mkZone "MSD" 4+                       , mkZone "SGT" 8+                       , mkZone "KST" 9+                       , mkZone "JST" 9+                       , mkZone "GST" 10+                       , mkZone "NZST" 12+                       , mkZone "NZDT" 13                          -- if we don't understand it, just give a GMT answer...                        , do { manyTill (oneOf $ ['a'..'z']++['A'..'Z']++[' '])                                        (lookAhead space_digit);
src/Lcs.hs view
@@ -440,17 +440,10 @@ initP :: [B.ByteString] -> PArray initP a = listArray (0, length a) (B.empty:a) -#if __GLASGOW_HASKELL__ > 604 aLen :: (IArray a e) => a Int e -> Int aLen a = snd $ bounds a aLenM :: (MArray a e m) => a Int e -> m Int aLenM a = getBounds a >>= return . snd-#else-aLen :: HasBounds a => a Int e -> Int-aLen a = snd $ bounds a-aLenM :: (HasBounds a, Monad m) => a Int e -> m Int-aLenM = return . snd . bounds-#endif  convertPatch :: Int -> PArray -> PArray -> (Int, Int, Int, Int)              -> (Int,[B.ByteString],[B.ByteString])
src/OldDate.hs view
@@ -26,6 +26,8 @@ import System.Time import Data.Char ( toUpper, isDigit ) import Control.Monad ( liftM, liftM2 )+import qualified Data.ByteString.Char8 as B+import Data.Maybe ( fromMaybe )  -- | Read/interpret a date string, assuming UTC if timezone --   is not specified in the string@@ -40,20 +42,22 @@  parseDate :: Int -> String -> Either String CalendarTime parseDate tz d =-              if length d >= 14 && and (map isDigit $ take 14 d)+              if length d >= 14 && B.all isDigit bd               then Right $-                   CalendarTime (read $ take 4 d)-                                (toEnum $ (+ (-1)) $ read $ take 2 $ drop 4 d)-                                (read $ take 2 $ drop 6 d) -- Day-                                (read $ take 2 $ drop 8 d) -- Hour-                                (read $ take 2 $ drop 10 d) -- Minute-                                (read $ take 2 $ drop 12 d) -- Second+                   CalendarTime (readI $ B.take 4 bd)+                                (toEnum $ (+ (-1)) $ readI $ B.take 2 $ B.drop 4 bd)+                                (readI $ B.take 2 $ B.drop 6 bd) -- Day+                                (readI $ B.take 2 $ B.drop 8 bd) -- Hour+                                (readI $ B.take 2 $ B.drop 10 bd) -- Minute+                                (readI $ B.take 2 $ B.drop 12 bd) -- Second                                 0 Sunday 0 -- Picosecond, weekday and day of year unknown                                 "GMT" 0 False               else let dt = do { x <- date_time tz; eof; return x }                    in case parse dt "" d of                       Left e -> Left $ "bad date: "++d++" - "++show e                       Right ct -> Right ct+  where bd = B.pack (take 14 d)+        readI s = fst $ fromMaybe (error "parseDate: invalid date") (B.readInt s)  showIsoDateTime :: CalendarTime -> String showIsoDateTime ct = concat [ show $ ctYear ct
src/Printer.lhs view
@@ -43,7 +43,8 @@                 hPutDocWith, hPutDocLnWith, putDocWith, putDocLnWith,                 renderString, renderStringWith, renderPS, renderPSWith,                 renderPSs, renderPSsWith, lineColor,-                prefix, colorText, invisibleText, hiddenText, hiddenPrefix, userchunk, text,+                prefix, insert_before_lastline, colorText, invisibleText, +                hiddenText, hiddenPrefix, userchunk, text,                 printable, wrap_text,                 blueText, redText, greenText, magentaText, cyanText,                 unsafeText, unsafeBoth, unsafeBothText, unsafeChar,@@ -55,9 +56,9 @@                 errorDoc,                ) where -import Control.Monad.Reader (Reader, runReader, ask, asks, local) import Data.List (intersperse) import System.IO (Handle, stdout, hPutStr)+import ByteStringUtils ( linesPS ) import qualified Data.ByteString as B (ByteString, hPut, concat) import qualified Data.ByteString.Char8 as BC (unpack, pack, singleton) @@ -148,11 +149,12 @@  -- | a 'Doc' is a bit of enriched text. 'Doc's get concatanated using -- '<>', which is right-associative.-newtype Doc = Doc { unDoc :: Reader St Document }+newtype Doc = Doc { unDoc :: St -> Document }  -- | The State associated with a doc. Contains a set of printers for each -- hanlde, and the current prefix of the document.-data St = St { printers :: !Printers', current_prefix :: !DocumentInternals }+data St = St { printers :: !Printers',+               current_prefix :: !([Printable] -> [Printable]) } type Printers = Handle -> Printers'  -- | A set of printers to print different types of text to a handle.@@ -162,20 +164,16 @@                            userchunkP :: !Printer,                            defP :: !Printer,                            lineColorT :: !(Color -> Doc -> Doc),-                           lineColorS :: !DocumentInternals+                           lineColorS :: !([Printable] -> [Printable])                           }-type Printer = Printable -> Reader St Document+type Printer = Printable -> St -> Document  data Color = Blue | Red | Green | Cyan | Magenta --- | 'DocumentInternals' represents a 'Printable' by the function--- which concatenates another 'Printable' to its right.-type DocumentInternals = [Printable] -> [Printable]---- | 'Document' is a wrapper around 'DocumentInternals' which allows+-- | 'Document' is a wrapper around '[Printable] -> [Printable]' which allows -- for empty Documents. The simplest 'Documents' are built from 'String's -- using 'text'.-data Document = Document DocumentInternals+data Document = Document ([Printable] -> [Printable])               | Empty  -- | renders a 'Doc' into a 'String' with control codes for the@@ -216,7 +214,7 @@ -- printers. Each item of the list corresponds to a string that was -- added to the doc. renderWith :: Printers' -> Doc -> [Printable]-renderWith ps (Doc d) = case runReader d (init_state ps) of+renderWith ps (Doc d) = case d (init_state ps) of                         Empty -> []                         Document f -> f [] @@ -224,28 +222,33 @@ init_state prs = St { printers = prs, current_prefix = id }  prefix :: String -> Doc -> Doc-prefix s (Doc d) =-    Doc $ local (\st -> st { current_prefix = current_prefix st . (p:) })-                   (do d' <- d-                       case d' of-                           Document d'' -> return $ Document $ (p:) . d''-                           Empty -> return Empty)-    where p = S s+prefix s (Doc d) = Doc $ \st ->+                   let p = S s+                       st' = st { current_prefix = current_prefix st . (p:) } in+                   case d st' of+                     Document d'' -> Document $ (p:) . d''+                     Empty -> Empty+                      +insert_before_lastline :: Doc -> Doc -> Doc+insert_before_lastline a b =+   case reverse $ map packedString $ linesPS $ renderPS a of+   (ll:ls) -> vcat (reverse ls) $$ b $$ ll+   [] -> error "empty Doc given as first argument of Printer.insert_before_last_line"++ lineColor :: Color -> Doc -> Doc-lineColor c d =-    Doc $ do pr <- asks printers-             unDoc $ lineColorT pr c d+lineColor c d = Doc $ \st -> case lineColorT (printers st) c d of+                             Doc d' -> d' st  hiddenPrefix :: String -> Doc -> Doc hiddenPrefix s (Doc d) =-    Doc $ do pr <- asks printers-             let p = S (renderStringWith pr $ hiddenText s)-             local (\st -> st { current_prefix = current_prefix st . (p:) })-                       (do d' <- d-                           case d' of-                             Document d'' -> return $ Document $ (p:) . d''-                             Empty -> return Empty)+    Doc $ \st -> let pr = printers st+                     p = S (renderStringWith pr $ hiddenText s)+                     st' = st { current_prefix = current_prefix st . (p:) }+                 in case d st' of+                      Document d'' -> Document $ (p:) . d''+                      Empty -> Empty  -- | 'unsafeBoth' builds a Doc from a 'String' and a 'B.ByteString' representing -- the same text, but does not check that they do.@@ -272,7 +275,7 @@  -- | 'unsafeChar' creates a Doc containing just one character. unsafeChar :: Char -> Doc-unsafeChar = unsafeText . return+unsafeChar = unsafeText . (:"")  -- | 'text' creates a 'Doc' from a @String@, using 'printable'. text :: String -> Doc@@ -312,17 +315,13 @@  -- | 'printable x' creates a 'Doc' from any 'Printable'. printable, invisiblePrintable, hiddenPrintable, userchunkPrintable :: Printable -> Doc-printable x = Doc $ do st <- ask-                       defP (printers st) x+printable x = Doc $ \st -> defP (printers st) x st+ mkColorPrintable :: Color -> Printable -> Doc-mkColorPrintable c x = Doc $ do st <- ask-                                colorP (printers st) c x-invisiblePrintable x = Doc $ do st <- ask-                                invisibleP (printers st) x-hiddenPrintable x = Doc $ do st <- ask-                             hiddenP (printers st) x-userchunkPrintable x = Doc $ do st <- ask-                                userchunkP (printers st) x+mkColorPrintable c x = Doc $ \st -> colorP (printers st) c x st+invisiblePrintable x = Doc $ \st -> invisibleP (printers st) x st+hiddenPrintable x = Doc $ \st -> hiddenP (printers st) x st+userchunkPrintable x = Doc $ \st -> userchunkP (printers st) x st  -- | 'simplePrinters' is a 'Printers' which uses the set 'simplePriners\'' on any -- handle.@@ -343,8 +342,11 @@ -- | 'simplePrinter' is the simplest 'Printer': it just concatenates together -- the pieces of the 'Doc' simplePrinter :: Printer--- | 'invisiblePrinter' is the 'Printer' for hidden text. It seems to--- just replace the document with 'empty'. I'm confused (Florent).+-- | 'invisiblePrinter' is the 'Printer' for hidden text. It just replaces+-- the document with 'empty'.  It's useful to have a printer that doesn't+-- actually do anything because this allows you to have tunable policies,+-- for example, only printing some text if it's to the terminal, but not+-- if it's to a file or vice-versa. invisiblePrinter :: Printer simplePrinter x = unDoc $ doc (\s -> x:s) invisiblePrinter _ = unDoc empty@@ -355,9 +357,9 @@  -- | The empty 'Doc'. empty :: Doc-empty = Doc $ return Empty+empty = Doc $ const Empty doc :: ([Printable] -> [Printable]) -> Doc-doc f = Doc $ return $ Document f+doc f = Doc $ const $ Document f  -- | '(<>)' is the concatenation operator for 'Doc's (<>) :: Doc -> Doc -> Doc@@ -369,53 +371,40 @@ ($$) :: Doc -> Doc -> Doc -- a then b Doc a <> Doc b =-   Doc $ do ad <- a-            case ad of-                Empty -> b+   Doc $ \st -> case a st of+                Empty -> b st                 Document af ->-                    do bd <- b-                       return $ Document (\s -> af $ case bd of-                                                         Empty -> s-                                                         Document bf -> bf s)+                    Document (\s -> af $ case b st of+                                         Empty -> s+                                         Document bf -> bf s)  -- empty if a empty, else a then b Doc a <?> Doc b =-    Doc $ do ad <- a-             case ad of-                 Empty -> return Empty-                 Document af ->-                     do bd <- b-                        return $ Document (\s -> af $ case bd of-                                                          Empty -> s-                                                          Document bf -> bf s)+    Doc $ \st -> case a st of+                 Empty -> Empty+                 Document af -> Document (\s -> af $ case b st of+                                                     Empty -> s+                                                     Document bf -> bf s)  -- a then space then b Doc a <+> Doc b =-    Doc $ do ad <- a-             case ad of-                 Empty -> b-                 Document af ->-                     do bd <- b-                        return $ Document (\s -> af $ case bd of-                                                          Empty -> s-                                                          Document bf ->-                                                              space_p:bf s)+    Doc $ \st -> case a st of+                 Empty -> b st+                 Document af -> Document (\s -> af $ case b st of+                                                     Empty -> s+                                                     Document bf ->+                                                         space_p:bf s)  -- a above b Doc a $$ Doc b =-   Doc $ do ad <- a-            case ad of-                Empty -> b+   Doc $ \st -> case a st of+                Empty -> b st                 Document af ->-                    do bd <- b-                       st <- ask-                       let pf = current_prefix st-                           sf = lineColorS $ printers st-                       return $ Document (\s -> af-                                              $ case bd of-                                                    Empty -> s-                                                    Document bf ->-                                                        sf (newline_p:pf (bf s)))+                    Document (\s -> af $ case b st of+                                         Empty -> s+                                         Document bf -> sf (newline_p:pf (bf s)))+                        where pf = current_prefix st+                              sf = lineColorS $ printers st  -- | 'vcat' piles vertically a list of 'Doc's. vcat :: [Doc] -> Doc@@ -431,5 +420,6 @@ hcat :: [Doc] -> Doc hcat [] = empty hcat ds = foldr1 (<>) ds+ \end{code}
src/RegChars.hs view
@@ -26,12 +26,30 @@ (|||) a b c = a c || b c  {-# INLINE regChars #-}++-- | 'regChars' returns a filter function that tells if a char is a member+-- of the regChar expression or not. The regChar expression is basically a+-- set of chars, but it can contain ranges with use of the '-' (dash), and+-- it can also be specified as a complement set by prefixing with '^'+-- (caret). The dash and caret, as well as the backslash, can all be+-- escaped with a backslash to suppress their special meaning.+-- +-- NOTE: The '.' (dot) is allowed to be escaped. It has no special meaning+-- if it is not escaped, but the default 'filename_toks' in+-- Darcs.Commands.Replace uses an escaped dot (WHY?).+ regChars :: String -> (Char -> Bool) regChars ('^':cs) = not . normalRegChars (unescapeChars cs) regChars ('\\':'^':cs) = normalRegChars $ unescapeChars $ '^':cs regChars cs = normalRegChars $ unescapeChars cs  {-# INLINE unescapeChars #-}++-- | 'unescapeChars' unescapes whitespace, which is escaped in the replace+-- patch file format. It will also unescape escaped carets, which is useful+-- for escaping a leading caret that should not invert the regChars. All+-- other escapes are left for the unescaping in 'normalRegChars'.+ unescapeChars :: String -> String unescapeChars ('\\':'n':cs) = '\n' : unescapeChars cs unescapeChars ('\\':'t':cs) = '\t' : unescapeChars cs@@ -40,6 +58,11 @@ unescapeChars [] = []  {-# INLINE normalRegChars #-}++-- | 'normalRegChars' assembles the filter function. It handles special+-- chars, and also unescaping of escaped special chars. If a non-special+-- char is still escaped by now we get a failure.+ normalRegChars :: String -> (Char -> Bool) normalRegChars ('\\':'.':cs) = (=='.') ||| normalRegChars cs normalRegChars ('\\':'-':cs) = (=='-') ||| normalRegChars cs
src/SHA1.hs view
@@ -15,18 +15,18 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -cpp #-}+{-# LANGUAGE CPP #-} + -- {-# OPTIONS_GHC -fglasgow-exts -fno-warn-name-shadowing #-} -- -fglasgow-exts needed for nasty hack below -- name shadowing disabled because a,b,c,d,e are shadowed loads in step 4 module SHA1 (sha1PS) where -import Autoconf (big_endian) import ByteStringUtils (unsafeWithInternals) import qualified Data.ByteString as B (ByteString, pack, length, concat) -import Control.Monad (unless) import Data.Char (intToDigit) import Data.Bits (xor, (.&.), (.|.), complement, rotateL, shiftL, shiftR) import Data.Word (Word8, Word32)@@ -45,7 +45,9 @@        abcde' = unsafePerformIO               $ unsafeWithInternals s1_2 (\ptr len ->                     do let ptr' = castPtr ptr-                       unless big_endian $ fiddle_endianness ptr' len+#ifndef BIGENDIAN+                       fiddle_endianness ptr' len+#endif                        sha1_step_4_main abcde ptr' len)        s5 = sha1_step_5_display abcde'
src/Ssh.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} -module Ssh ( grabSSH, runSSH, getSSH, copySSH, copySSHs, SSHCmd(..) ) where+module Ssh ( grabSSH, runSSH, getSSH, copySSH, copySSHs, SSHCmd(..),+             environmentHelpSsh, environmentHelpScp, environmentHelpSshPort+           ) where  import Prelude hiding ( lookup, catch ) @@ -221,6 +223,38 @@      portFlag SSH  x = ["-p", x]      portFlag SCP  x = ["-P", x]      portFlag SFTP x = ["-oPort="++x]++environmentHelpSsh :: ([String], [String])+environmentHelpSsh = (["DARCS_SSH"], [+ "Repositories of the form [user@]host:[dir] are taken to be remote",+ "repositories, which Darcs accesses with the external program ssh(1).",+ "",+ "The environment variable $DARCS_SSH can be used to specify an",+ "alternative SSH client.  Arguments may be included, separated by",+ "whitespace.  The value is not interpreted by a shell, so shell",+ "constructs cannot be used; in particular, it is not possible for the",+ "program name to contain whitespace by using quoting or escaping."])++environmentHelpScp :: ([String], [String])+environmentHelpScp = (["DARCS_SCP", "DARCS_SFTP"], [+ "When reading from a remote repository, Darcs will attempt to run",+ "`darcs transfer-mode' on the remote host.  This will fail if the",+ "remote host only has Darcs 1 installed, doesn't have Darcs installed",+ "at all, or only allows SFTP.",+ "",+ "If transfer-mode fails, Darcs will fall back on scp(1) and sftp(1).",+ "The commands invoked can be customized with the environment variables",+ "$DARCS_SCP and $DARCS_SFTP respectively, which behave like $DARCS_SSH.",+ "If the remote end allows only sftp, try setting DARCS_SCP=sftp."])++environmentHelpSshPort :: ([String], [String])+environmentHelpSshPort = (["SSH_PORT"], [+ "If this environment variable is set, it will be used as the port",+ "number for all SSH calls made by Darcs (when accessing remote",+ "repositories over SSH).  This is useful if your SSH server does not",+ "run on the default port, and your SSH client does not support",+ "ssh_config(5).  OpenSSH users will probably prefer to put something",+ "like `Host *.example.net Port 443' into their ~/.ssh/config file."])  -- | Return True if this version of ssh has a ControlMaster feature -- The ControlMaster functionality allows for ssh multiplexing
+ src/ThisVersion.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -cpp #-}++module ThisVersion ( darcs_version ) where++#ifndef PACKAGE_VERSION+#define PACKAGE_VERSION "0"+#define PACKAGE_VERSION_STATE "no version info"+#endif++{-# NOINLINE darcs_version #-}+darcs_version :: String+darcs_version = PACKAGE_VERSION ++ " (" ++ PACKAGE_VERSION_STATE ++ ")"
− src/ThisVersion.hs.in 
@@ -1,8 +0,0 @@------ Version information created at compile time by make.----module ThisVersion ( darcs_version ) where--{-# NOINLINE darcs_version #-}-darcs_version :: String-darcs_version = "@DARCS_VERSION@ (@DARCS_VERSION_STATE@)"
src/URL.hs view
@@ -2,7 +2,8 @@  module URL ( copyUrl, copyUrlFirst, pipeliningEnabledByDefault,              setDebugHTTP, setHTTPPipelining, waitUrl,-             Cachable(Cachable, Uncachable, MaxAge)+             Cachable(Cachable, Uncachable, MaxAge),+             environmentHelpProxy, environmentHelpProxyPassword            ) where  import Data.IORef ( newIORef, readIORef, writeIORef, IORef )@@ -27,9 +28,9 @@ import Numeric ( showHex ) import System.Random ( randomRIO ) -#if defined(HAVE_CURL) || defined(HAVE_LIBWWW)+#ifdef HAVE_CURL import Foreign.C.String ( withCString, peekCString, CString )-#elif defined(HAVE_HTTP)+#else import qualified HTTP ( request_url, wait_next_url ) #endif #include "impossible.h"@@ -79,13 +80,13 @@  data Priority = High | Low deriving Eq -#if defined(CURL_PIPELINING) || defined(HAVE_LIBWWW) || defined(CURL_PIPELINING_DEFAULT)+#if defined(CURL_PIPELINING) || defined(CURL_PIPELINING_DEFAULT) pipeliningLimit :: Int pipeliningLimit = 100 #endif  pipeliningEnabledByDefault :: Bool-#if defined(HAVE_LIBWWW) || defined(CURL_PIPELINING_DEFAULT)+#ifdef CURL_PIPELINING_DEFAULT pipeliningEnabledByDefault = True #else pipeliningEnabledByDefault = False@@ -94,7 +95,7 @@ {-# NOINLINE maxPipeLength #-} maxPipeLength :: IORef Int maxPipeLength = unsafePerformIO $ newIORef $-#if defined(HAVE_LIBWWW) || defined(CURL_PIPELINING_DEFAULT)+#ifdef CURL_PIPELINING_DEFAULT                 pipeliningLimit #else                 1@@ -184,18 +185,20 @@     case readQ w of       Just (u,rest) -> do         case Map.lookup u (inProgress st) of-          Just (f, _, c, _) -> do-            put $ st { waitToStart = rest-                     , pipeLength = l + 1 }+          Just (f, _, c, v) -> do             dbg ("URL.request_url ("++u++"\n"++                  "              -> "++f++")")             let f_new = f++"-new_"++randomJunk st-            liftIO $ do err <- request_url u f_new c-                        if null err-                           then do atexit $ removeFileMayNotExist f_new-                                   debugMessage "URL.request_url succeeded"-                           else do removeFileMayNotExist f_new-                                   debugMessage $ "Failed to start download URL "++u++": "++err+            err <- liftIO $ request_url u f_new c+            if null err+               then do dbg "URL.request_url succeeded"+                       liftIO $ atexit (removeFileMayNotExist f_new)+                       put $ st { waitToStart = rest+                                , pipeLength = l + 1 }+               else do dbg $ "Failed to start download URL "++u++": "++err+                       liftIO $ do removeFileMayNotExist f_new+                                   putMVar v err+                       put $ st { waitToStart = rest }           _              -> bug $ "Possible bug in URL.checkWaitToStart "++u         checkWaitToStart       _ -> return ()@@ -267,7 +270,7 @@ minCachable _          (MaxAge b) = MaxAge b minCachable _          _          = Cachable -#if defined(HAVE_CURL) || defined(HAVE_LIBWWW)+#ifdef HAVE_CURL cachableToInt :: Cachable -> CInt cachableToInt Cachable = -1 cachableToInt Uncachable = 0@@ -277,7 +280,7 @@ setHTTPPipelining :: Bool -> IO () setHTTPPipelining False = writeIORef maxPipeLength 1 setHTTPPipelining True = writeIORef maxPipeLength-#if defined(HAVE_LIBWWW) || defined(CURL_PIPELINING)+#ifdef CURL_PIPELINING     pipeliningLimit #else     1 >> (putStrLn $ "Warning: darcs is compiled without HTTP pipelining "++@@ -288,34 +291,7 @@ request_url :: String -> FilePath -> Cachable -> IO String wait_next_url :: IO (String, String) -#if defined(HAVE_LIBWWW)--setDebugHTTP = libwww_enable_debug--request_url u f cache =-    withCString u $ \ustr ->-    withCString f $ \fstr -> do-      err <- libwww_request_url ustr fstr (cachableToInt cache) >>= peekCString-      return err--wait_next_url = do-  e <- libwww_wait_next_url >>= peekCString-  u <- libwww_last_url >>= peekCString-  return (u, e)--foreign import ccall "hslibwww.h libwww_request_url"-  libwww_request_url :: CString -> CString -> CInt -> IO CString--foreign import ccall "hslibwww.h libwww_wait_next_url"-  libwww_wait_next_url :: IO CString--foreign import ccall "hslibwww.h libwww_last_url"-  libwww_last_url :: IO CString--foreign import ccall "hslibwww.h libwww_enable_debug"-  libwww_enable_debug :: IO ()--#elif defined(HAVE_CURL)+#ifdef HAVE_CURL  setDebugHTTP = curl_enable_debug @@ -350,8 +326,45 @@  #else -setDebugHTTP = debugMessage "URL.setDebugHttp works only with curl and libwww"-request_url _ _ _ = debugFail "URL.request_url: there is no curl or libwww!"-wait_next_url = debugFail "URL.wait_next_url: there is no curl or libwww!"+setDebugHTTP = debugMessage "URL.setDebugHttp works only with libcurl"+request_url _ _ _ = debugFail "URL.request_url: there is no libcurl!"+wait_next_url = debugFail "URL.wait_next_url: there is no libcurl!"  #endif++-- Usage of these environment variables happens in C code, so the+-- closest to "literate" user documentation is here, where the+-- offending function 'curl_request_url' is imported.+environmentHelpProxy :: ([String], [String])+environmentHelpProxy = (["HTTP_PROXY", "HTTPS_PROXY", "FTP_PROXY",+                         "ALL_PROXY", "NO_PROXY"], [+ "If Darcs was built with libcurl, the environment variables HTTP_PROXY,",+ "HTTPS_PROXY and FTP_PROXY can be set to the URL of a proxy in the form",+ "",+ "  [protocol://]<host>[:port]",+ "",+ "In which case libcurl will use the proxy for the associated protocol",+ "(HTTP, HTTPS and FTP).  The environment variable ALL_PROXY can be used",+ "to set a single proxy for all libcurl requests.",+ "",+ "If the environment variable NO_PROXY is a comma-separated list of host",+ "names, access to those hosts will bypass proxies defined by the above",+ "variables.  For example, it is quite common to avoid proxying requests",+ "to machines on the local network with",+ "",+ "  NO_PROXY=localhost,*.localdomain",+ "",+ "For compatibility with lynx et al, lowercase equivalents of these",+ "environment variables (e.g. $http_proxy) are also understood and are",+ "used in preference to the uppercase versions.",+ "",+ "If Darcs was not built with libcurl, all these environment variables",+ "are silently ignored, and there is no way to use a web proxy."])++environmentHelpProxyPassword :: ([String], [String])+environmentHelpProxyPassword = (["DARCS_PROXYUSERPWD"], [+ "If Darcs was built with libcurl, and you are using a web proxy that",+ "requires authentication, you can set the $DARCS_PROXYUSERPWD",+ "environment variable to the username and password expected by the",+ "proxy, separated by a colon.  This environment variable is silently",+ "ignored if Darcs was not built with libcurl."])
src/UTF8.lhs view
@@ -35,6 +35,10 @@ > module UTF8 >   ( encode ) where ++SUNSET: we should remove this module after the 2009-07 release+of darcs and just use Codec.Binary.UTF8.String instead+ #ifdef HAVE_UTF8STRING > import qualified Codec.Binary.UTF8.String (encode) > import Data.Word (Word8)
src/Workaround.hs view
@@ -5,16 +5,13 @@                     installHandler, raiseSignal, Handler(..), Signal,                     sigINT, sigHUP, sigABRT, sigALRM, sigTERM, sigPIPE ) where -#ifdef HAVE_SIGNALS-import System.Posix.Signals(installHandler, raiseSignal, Handler(..), Signal,-                         sigINT, sigHUP, sigABRT, sigALRM, sigTERM, sigPIPE,)-#endif- #ifdef WIN32 import qualified System.Directory ( renameFile, getCurrentDirectory, removeFile ) import qualified Control.Exception ( block ) import qualified System.IO.Error ( isDoesNotExistError, ioError, catch ) #else+import System.Posix.Signals(installHandler, raiseSignal, Handler(..), Signal,+                            sigINT, sigHUP, sigABRT, sigALRM, sigTERM, sigPIPE) import System.Directory ( renameFile, getCurrentDirectory ) import System.Posix.Files (fileMode,getFileStatus, setFileMode,                            setFileCreationMask,@@ -24,7 +21,7 @@ import Data.Bits ( (.&.), (.|.), complement ) #endif -#ifndef HAVE_SIGNALS+#ifdef WIN32 -- Dummy implementation of POSIX signals data Handler = Default | Ignore | Catch (IO ()) type Signal = Int@@ -44,9 +41,7 @@ sigTERM = 0 sigPIPE = 0 sigALRM = 0-#endif -#ifdef WIN32 {- System.Directory.renameFile incorrectly fails when the new file already exists.  This code works around that bug at the cost of losing atomic
src/best_practices.tex view
@@ -408,11 +408,11 @@ $ echo cache:$HOME/.darcs/cache > $HOME/.darcs/sources \end{verbatim} -In Windows, using \verb|cmd.exe| (Command Prompt under Accessories):+On MS Windows~\ref{ms_win}, using \verb|cmd.exe| (Command Prompt under Accessories):  \begin{verbatim}-> md %UserProfile%\.darcs\cache-> echo cache:%UserProfile%\Application Data\darcs\cache > %UserProfile%\Application Data\darcs\sources+> md "%UserProfile%\Application Data\darcs\cache" (notice double quotes!)+> echo cache:%UserProfile%\Application Data\darcs\cache > "%UserProfile%\Application Data\darcs\sources" \end{verbatim}  There are some other advanced things you can do in \verb!_darcs/prefs/sources!,
src/building_darcs.tex view
@@ -1,160 +1,93 @@ \chapter{Building darcs}--This chapter should walk you through the steps necessary to build darcs for-yourself.  There are in general two ways to build darcs.  One is for-building released versions from tarballs, and the other is to build the-latest and greatest darcs, from the darcs repo itself.--Please let me know if you have any problems building darcs, or don't have-problems described in this chapter and think there's something obsolete-here, so I can keep this page up-to-date.--\section{Prerequisites}-To build darcs you will need to have {\tt ghc}, the Glorious Glasgow-Haskell Compiler. You should have at the very minimum version 6.4.--It is a good idea (but not required) to have software installed that provide darcs-network access. The {\tt libwww-dev}, {\tt libwww-ssl-dev} or {\tt libcurl} packages-newer than than 7.18.0 are recommended because they provide pipelining support speed-up HTTP access. They have to be explicitly chosen with {\tt --with-libwww} or-{\tt --with-curl-pipelining}. Otherwise, darcs will automatically look for one of-libcurl, {\tt curl} or {\tt wget}.  You also might want to have scp-available if you want to grab your repos over ssh\ldots--To use the \verb!diff! command of darcs, a \verb!diff! program supporting-options \verb!-r! (recursive diff) and \verb!-N! (show new files as-differences against an empty file) is required. The \verb!configure!-script will look for \verb!gdiff!, \verb!gnudiff! and \verb!diff! in this-order. You can force the use of another program by setting the \verb!DIFF!-environment variable before running \verb!configure!.--To rebuild the documentation (which should not be necessary since it is-included in html form with the tarballs), you will need to have latex-installed, as well as latex2html if you want to build it in html form.---\section{Building on Mac~OS~X}-To build on Mac~OS~X, you will need the Apple Developer Tools and the ghc-6.4 package installed.--\section{Building on Microsoft Windows}-To build on Microsoft Windows, you will need:--\begin{itemize}-\item \htmladdnormallinkfoot{MinGW}{http://www.mingw.org/} which provides the GCC-  toolchain for win32.-\item \htmladdnormallinkfoot{MSYS}{http://www.mingw.org/msys.shtml} which provides-  a unix build environment for win32.  Be sure to download the separate-  msysDTK, autoconf and automake.-\item \htmladdnormallinkfoot{zlib-1.2.1+}{http://www.gzip.org/zlib/} library-  and headers.-\item \htmladdnormallinkfoot{curl-7.12.2+}{http://curl.haxx.se/} library-  and headers.-\item If building with an SSL enabled curl you will need the OpenSSL-  libraries, unofficial builds are available at\\-  \htmladdnormallink{http://www.slproweb.com/products/Win32OpenSSL.html}{http://www.slproweb.com/products/Win32OpenSSL.html}.-\end{itemize}--Copy the zlib and curl libraries and headers to both GHC and MinGW.  GHC-stores C headers in \verb!<ghc-dir>/gcc-lib/include! and libraries in-\verb!<ghc-dir>/gcc-lib!.  MinGW stores headers in-\verb!<mingw-dir>/include! and libraries in \verb!<mingw-dir>/lib!.--Set PATH to include the \verb!<msys-dir>/bin!, \verb!<mingw-dir>/bin!,-\verb!<curl-dir>!, and a directory containing a pre-built darcs.exe if you-want the build's patch context stored for `\verb!darcs --exact-version!'.--\begin{verbatim}-C:\darcs> cd <darcs-source-dir>-C:\darcs> sh--$ export GHC=/c/<ghc-dir>/bin/ghc.exe-$ autoconf-$ ./configure --target=mingw-$ make-\end{verbatim}--\section{Building from tarball}-If you get darcs from a tarball, the procedure (after unpacking the tarball-itself) is as follows:-\begin{verbatim}-$ ./configure-$ make-# Optional, but recommended-$ make test-$ make install-\end{verbatim}+\section{The Easy Way}+If your distribution provides a pre-built binary package of a recent+Darcs release, you are strongly encouraged to use that rather than+building Darcs yourself. -There are options to configure that you may want to check out with+If you have (or can install) the \texttt{cabal-install} package, this+is the next best option, as this will resolve build dependencies+automatically.  To download, compile and install Darcs and its+dependencies via cabal-install, simply run \begin{verbatim}-$ ./configure --help+cabal update+cabal install darcs \end{verbatim} -If your header files are installed in a non-standard location, you may need-to define the \verb!CFLAGS! and \verb!CPPFLAGS! environment variables to-include the path to the headers.  e.g. on NetBSD, you may need to run+\section{The Hard Way}+If you cannot install \texttt{cabal-install}, you need to run \begin{verbatim}-$ CFLAGS=-I/usr/pkg/include CPPFLAGS=-I/usr/pkg/include ./configure+ghc --make Setup+./Setup configure+./Setup build+./Setup install \end{verbatim} -\section{Building darcs from the repository}-To build the latest darcs from its repository, you will first need a-working copy of Darcs 2. You can get darcs using:-\begin{verbatim}-$ darcs get -v http://darcs.net/-\end{verbatim}-and once you have the darcs repository you can bring it up to date with a-\begin{verbatim}-$ darcs pull-\end{verbatim}+This will require the following build dependencies:+\begin{itemize}+\item GHC 6.8 or higher; and+\item Cabal 1.6 or higher.+\end{itemize} -The repository doesn't hold automatically generated files, which include-the configure script and the HTML documentation, so you need to run-\verb!autoconf! first.+%% Note: darcs.cabal tends to have build dependencies [x,y), but I+%% couldn't work out a way to describe this concisely (and+%% intelligibly to non-mathematicians).  So I have lied and simply+%% said `or higher', since the upper bounds usually only declare+%% incompatibility with versions that don't exist yet. --twb, 2009 -You'll need \verb!autoconf! 2.50 or higher. Some systems have more than one-version of \verb!autoconf! installed. For example, \verb!autoconf! may point to-version 2.13, while \verb!autoconf259!  runs version 2.59.+Additional build dependencies are declared in the \texttt{darcs.cabal}+file, and \texttt{./Setup configure} will tell you if any required+build dependencies aren't found.  The build dependencies at time of+writing (Darcs 2.3) are as follows:+\begin{itemize}+\item the C library zlib;+\item the Haskell packages+  \begin{itemize}+  \item array 1.1 or 1.2;+  \item containers 1.1 or 1.2;+  \item directory 1.0;+  \item filepath 1.1;+  \item hashed-storage 0.3;+  \item haskeline 0.6.1 or higher;+  \item html 1.0;+  \item mtl 1.0 or 1.1;+  \item old-time 1.0;+  \item parsec 2.1 or higher;+  \item process 1.0;+  \item random 1.0; and+  \item regex-compat 0.71 or higher.+  \end{itemize}+\end{itemize} -Also note that \verb!make! is really "GNU make". On some systems, such as-the *BSDs, you may need to type \verb!gmake! instead of make for this to work.+Missing \emph{optional} build dependencies are only listed if+\texttt{./Setup configure} is passed the \texttt{--verbose} argument.+At time of writing they are:+\begin{itemize}+\item the C library libcurl (7.19.1 or higher recommended);+\item the Haskell packages+  \begin{itemize}+  \item bytestring 0.9;+  \item bytestring-mmap 0.2 or higher;+  \item http 3000 or 3001.1;+  \item network 2.2;+  \item terminfo 0.3.+  \item utf8-string 0.3; and+  \item zlib 0.5.+  \end{itemize}+\end{itemize} -If you want to create readable documentation you'll need to have latex installed.+\section{The Old Way}+Darcs can still be built with GNU autotools; this approach is+deprecated and will be removed after the 2.3 release.  Run \begin{verbatim}-$ autoconf-$ ./configure-$ make-$ make install+autoconf+./configure+make+make install \end{verbatim} -If you want to tweak the configure options, you'll need to run {\tt-  ./configure} yourself after the make, and then run make again.--\section{Submitting patches to darcs}-I know, this doesn't really belong in this chapter, but if you're using the-repository version of darcs it's really easy to submit patches to me using-darcs. In fact, even if you don't know any Haskell, you could submit fixes-or additions to this document (by editing \verb!building_darcs.tex!) based-on your experience building darcs\ldots--To do so, just record your changes (which you made in the darcs repository)-\begin{verbatim}-$ darcs record --no-test-\end{verbatim}-making sure to give the patch a nice descriptive name.  The-\verb!--no-test! options keeps darcs from trying to run the unit tests,-which can be rather time-consuming.  Then you can send the patch to the-darcs-devel mailing list by email by-\begin{verbatim}-$ darcs send-\end{verbatim}-If you are using darcs 2.0.0 or earlier, please use-\begin{verbatim}-$ darcs send -u-\end{verbatim}-instead.-The darcs repository stores the email address to which patches should be-sent by default.  The email address you see is actually my own, but when-darcs notices that you haven't signed the patch with my GPG key, it will-forward the message to darcs-devel.-+The build dependencies are identical to the previous approach, except+that instead of the \texttt{Cabal} package, you will need+\begin{itemize}+\item GNU Make; and+\item GNU autoconf 2.50 or higher.+\end{itemize}
src/configuring_darcs.tex view
@@ -21,11 +21,18 @@ repository.  Such configuration only applies when working with that repository.  To configure darcs on a per-user rather than per-repository basis (but with essentially the same methods), you can edit (or create)-files in the \verb!~/.darcs/! directory (or on Microsoft Windows, the-C:/Documents And Settings/user/Application Data/darcs directory).+files in the \verb!~/.darcs/! directory. Finally, the behavior of some darcs commands can be modified by setting appropriate environment variables. +\paragraph{Microsoft Windows}\label{ms_win}++The global darcs directory is \verb!%APPDATA%\darcs\!.  This typically expands to+\texttt{C:\textbackslash{}Documents And Settings\textbackslash{}\emph{user}\textbackslash{}Application Data\textbackslash{}darcs\textbackslash{}}.+This folder contains the cache, as well as all the per-user+settings files: preferences, boring etc... These will became the new defaults+that can be overridden on per-repository basis.+ \input{Darcs/Repository/Prefs.lhs}  \input{Darcs/Repository/Motd.lhs}@@ -52,7 +59,6 @@ DARCS\_MGET\_FOO & \ref{env:DARCS_X_FOO} \\ DARCS\_MGETMAX & \ref{env:DARCS_MGETMAX} \\ DARCS\_PROXYUSERPWD & \ref{env:DARCS_PROXYUSERPWD} \\-DARCS\_WGET & \ref{env:DARCS_WGET} \\ DARCS\_SSH & \ref{env:DARCS_SSH} \\ DARCS\_SCP & \ref{env:DARCS_SCP} \\ DARCS\_SFTP & \ref{env:DARCS_SFTP} \\@@ -74,91 +80,18 @@  \section{General-purpose variables} -\paragraph{DARCS\_EDITOR}-\label{env:DARCS_EDITOR}-When pulling up an editor (for example, when adding a long comment in-record), darcs uses the contents of DARCS\_EDITOR if it is defined.  If-not, it tries the contents of VISUAL, and if that isn't defined (or fails-for some reason), it tries EDITOR\@.  If none of those environment variables-are defined, darcs tries \verb!vi!, \verb!emacs!, \verb!emacs -nw! and-\verb!nano! in that order.--\paragraph{DARCS\_PAGER}-\label{env:DARCS_PAGER}-When using a pager for displaying a patch, darcs uses the contents of-DARCS\_PAGER if it is defined.  If not, it tries the contents of PAGER-and then \verb!less!.--\paragraph{DARCS\_TMPDIR}-\label{env:DARCS_TMPDIR}-If the environment variable DARCS\_TMPDIR is defined, darcs will use that-directory for its temporaries.  Otherwise it will use TMPDIR, if that is-defined, and if not that then \verb!/tmp! and if \verb!/tmp! doesn't exist,-it'll put the temporaries in \verb!_darcs!.--This is very helpful, for example, when recording with a test suite that-uses MPI, in which case using \verb!/tmp! to hold the test copy is no good,-as \verb!/tmp! isn't shared over NFS and thus the \verb!mpirun! call will-fail, since the binary isn't present on the compute nodes.--\paragraph{DARCS\_KEEP\_TMPDIR}-\label{env:DARCS_KEEP_TMPDIR}-If the environment variable DARCS\_KEEP\_TMPDIR is defined, darcs will-not remove temprary directories.--This can be useful for darcs debugging.--\paragraph{HOME}-\label{env:HOME}-HOME is used to find the per-user prefs directory, which is located at-\verb!$HOME/.darcs!.--%$ this dollar is a comment to make my emacs leave math mode... (stupid-%  emacs)--\paragraph{TERM}-\label{env:TERM}-If darcs is compiled with libcurses support and support for color output,-it uses the environment variable TERM to decide whether or not color is-supported on the output terminal.+\darcsEnv{DARCS_EDITOR}+\darcsEnv{DARCS_PAGER}+\darcsEnv{DARCS_TMPDIR}+\darcsEnv{DARCS_KEEP_TMPDIR}+\darcsEnv{HOME}  \section{Remote repositories}--\paragraph{SSH\_PORT}-\label{env:SSH_PORT}-When using ssh, if the SSH\_PORT environment variable is defined, darcs will-use that port rather than the default ssh port (which is 22).--\paragraph{DARCS\_SSH}-\label{env:DARCS_SSH}-The DARCS\_SSH environment variable defines the command that darcs will use-when asked to run ssh.  This command is \emph{not} interpreted by a shell,-so you cannot use shell metacharacters, and the first word in the command-must be the name of an executable located in your path.--\paragraph{DARCS\_SCP and DARCS\_SFTP}-\label{env:DARCS_SCP}-\label{env:DARCS_SFTP}-The DARCS\_SCP and DARCS\_SFTP environment variables define the-commands that darcs will use when asked to run scp or sftp.  Darcs uses-scp and sftp to access repositories whose address is of the-form \verb!user@foo.org:foo! or \verb!foo.org:foo!.  Darcs will use-scp to copy single files (e.g.\ repository meta-information), and sftp-to copy multiple files in batches (e.g.\ patches).  These commands are-\emph{not} interpreted by a shell, so you cannot use shell-metacharacters, and the first word in the command must be the name of-an executable located in your path.  By default, \verb!scp! and \verb!sftp!-are used.  When you can use sftp, but not scp (e.g.\ some ISP web sites), it-works to set DARCS\_SCP to `sftp'.  The other way around does not work, i.e.\ -DARCS\_FTP must reference an sftp program, not scp.--\paragraph{DARCS\_PROXYUSERPWD}-\label{env:DARCS_PROXYUSERPWD}-This environment variable allows DARCS and libcurl to access remote repositories-via a password-protected HTTP proxy. The proxy itself is specified with the standard-environment variable for this purpose, namely 'http\_proxy'. The DARCS\_PROXYUSERPWD-environment variable specifies the proxy username and password. It must be given in -the form \emph{username:password}.+\darcsEnv{DARCS_SSH}+\darcsEnv{DARCS_SCP}+\darcsEnv{SSH_PORT}+\darcsEnv{HTTP_PROXY}+\darcsEnv{DARCS_PROXYUSERPWD}  \paragraph{DARCS\_GET\_FOO, DARCS\_MGET\_FOO and DARCS\_APPLY\_FOO} \label{env:DARCS_X_FOO}@@ -181,6 +114,54 @@ wget -q -O - \end{verbatim} +Apart from such toy examples, it is likely that you will need to+manipulate the argument before passing it to the actual fetcher+program.  For example, consider the problem of getting read access to+a repository on a CIFS (SMB) share without mount privileges:++\begin{verbatim}+export DARCS_GET_SMB="smbclient -c get"+darcs get smb://fs/twb/Desktop/hello-world+\end{verbatim}++The above command will not work for several reasons.  Firstly, Darcs+will pass it an argument beginning with `smb:', which smbclient does+not understand.  Secondly, the host and share `//fs/twb' must be+presented as a separate argument to the path `Desktop/hello-world'.+Thirdly, smbclient requires that `get' and the path be a single+argument (including a space), rather than two separate arguments.+Finally, smbclient's `get' command writes the file to disk, while+Darcs expects it to be printed to standard output.++In principle, we could get around such problems by making the variable+contain a shell script, e.g.++\begin{verbatim}+export DARCS_GET_SMB='sh -c "...; smbclient $x -c \"get $y\""'+\end{verbatim}++Unfortunately, Darcs splits the command on whitespace and does not+understand that quotation or escaping, so there is no way to make+Darcs pass the text after `-c' to sh as a single argument.  Therefore,+we instead need to put such one-liners in separate, executable scripts.++Continuing our smbclient example, we create an executable script+\verb|~/.darcs/libexec/get_smb| with the following contents:++\begin{verbatim}+#!/bin/bash -e+IFS=/ read host share file <<<"${1#smb://}"+smbclient //$host/$share -c "get $file -"+\end{verbatim}++And at last we can say++\begin{verbatim}+export DARCS_GET_SMB=~/.darcs/libexec/get_smb+darcs get smb://fs/twb/Desktop/hello-world+\end{verbatim}++ If set, DARCS\_MGET\_FOO will be used to fetch many files from a single repository simultaneously. Replace FOO and foo as appropriate to handle other URL schemes.@@ -203,30 +184,9 @@ number of URLs presented to the command to the value of this variable, if set, or 200. -\paragraph{DARCS\_WGET}-\label{env:DARCS_WGET}-This is a very old option that is only used if libcurl is not compiled-in and one of the DARCS\_GET\_FOO is not used. Using one of those-is recommended instead.--The DARCS\_WGET environment variable defines the command that darcs-will use to fetch all URLs for remote repositories.  The first word in-the command must be the name of an executable located in your path.-Extra arguments can be included as well, such as:--\begin{verbatim}-wget -q -\end{verbatim}--Darcs will append \verb!-i! to the argument list, which it uses to provide a-list of URLS to download. This allows wget to download multiple patches at the-same time. It's possible to use another command besides \verb!wget! with this-environment variable, but it must support the \verb!-i! option in the same way. - These commands are \emph{not} interpreted by a shell, so you cannot use shell meta-characters. - \section{Highlighted output} \label{env:DARCS_ALWAYS_COLOR} \label{env:DARCS_DO_COLOR_LINES}@@ -272,7 +232,7 @@ and darcs will display all the printables in the current system locale instead of just the ASCII ones. NOTE: This curently does not work on some architectures if darcs is-compiled with GHC~6.4. Some non-ASCII control characters might be printed+compiled with GHC~6.4 or later. Some non-ASCII control characters might be printed and can possibly spoof the terminal.  For multi-byte character encodings things are less smooth.
src/darcs.hs view
@@ -24,13 +24,12 @@ import System.IO ( stdin, stdout ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs )-import Control.Monad ( when ) import Control.Exception ( Exception( AssertionFailed ), handleJust, catchDyn )  import Darcs.RunCommand ( run_the_command ) import Darcs.Flags ( DarcsFlag(Verbose) ) import Darcs.Commands.Help ( help_cmd, list_available_commands, print_version )-import Autoconf( darcs_version )+import ThisVersion ( darcs_version ) import Darcs.SignalHandler ( withSignalsHandled ) import Context ( context ) import Darcs.Global ( with_atexit )@@ -52,24 +51,22 @@ main = with_atexit $ withSignalsHandled $   flip catchDyn execExceptionHandler $   handleJust assertions bug $ do-  argv <- getArgs;-  when (length argv < 1) $-       do print_version-          help_cmd [] []-  when (length argv == 1 && (argv!!0 == "-h" || argv!!0 == "--help")) $-       help_cmd [] []-  when (length argv == 1 && (argv!!0 == "--overview")) $-       help_cmd [Verbose] []-  when (length argv == 1 && (argv!!0 == "-v" || argv!!0 == "--version")) $-       do putStrLn darcs_version-          exitWith $ ExitSuccess-  when (length argv == 1 && (argv!!0 == "--exact-version")) $-       do putStrLn $ "darcs compiled on "++__DATE__++", at "++__TIME__-          putStrLn context-          exitWith $ ExitSuccess-  when (length argv == 1 && argv!!0 == "--commands") $-       do list_available_commands-          exitWith $ ExitSuccess-  hSetBinaryMode stdin True-  hSetBinaryMode stdout True-  run_the_command (head argv) (tail argv)+  argv <- getArgs+  case argv of+    -- User called "darcs" without arguments.+    []                  -> print_version >> help_cmd [] []+    -- User called "darcs --foo" for some special foo.+    ["-h"]              -> help_cmd [] []+    ["--help"]          -> help_cmd [] []+    ["--overview"]      -> help_cmd [Verbose] []+    ["--commands"]      -> list_available_commands+    ["-v"]              -> putStrLn darcs_version+    ["--version"]       -> putStrLn darcs_version+    ["--exact-version"] -> do+              putStrLn $ "darcs compiled on "++__DATE__++", at "++__TIME__+              putStrLn context+    -- User called a normal darcs command, "darcs foo [args]".+    _ -> do+      hSetBinaryMode stdin True+      hSetBinaryMode stdout True+      run_the_command (head argv) (tail argv)
− src/darcsman.hs 
@@ -1,97 +0,0 @@--- Copyright (C) 2003 David Roundy------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2, or (at your option)--- any later version.------ This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software Foundation,--- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.--module Main (main) where--import Darcs.Commands-import Darcs.TheCommands-import Time--main :: IO ()-main = man (extract_commands command_control_list)--man :: [DarcsCommand] -> IO ()-man cs = do man_header-            unorganized <- man_organizer cs-            putStrLn ".SH OTHER COMMANDS"-            man_helper unorganized-            man_trailer--man_organizer :: [DarcsCommand] -> IO [DarcsCommand]-man_organizer commands = mo commands-                         [("CREATING REPOSITORIES",-                           ["initialize","get"]),-                          ("MODIFYING REPOSITORY CONTENTS",-                           ["add","remove","mv","replace"]),-                          ("WORKING WITH CHANGES",-                           ["record","pull","push","send","apply"]),-                          ("SEEING WHAT YOU'VE DONE",-                           ["whatsnew","query"])-                         ]-    where mo :: [DarcsCommand] -> [(String,[String])] -> IO [DarcsCommand]-          mo cs [] = return cs-          mo cs ((t,a):xs) =-              do putStrLn $ ".SH " ++ t-                 man_helper $ filter ((`elem` a) . command_name) cs-                 mo (filter (not . (`elem` a) . command_name) cs) xs--man_helper :: [DarcsCommand] -> IO ()-man_helper cmds =-  helper' "" cmds-  where helper' _ [] = return ()-        helper' s (c@DarcsCommand { }:cs) = do-            putStrLn $ ".TP"-            putStrLn $ ".B "++ s ++ " "  ++ command_name c-            putStrLn $ command_help c-            helper' s cs-        helper' s (c@SuperCommand { }:cs) = do-            helper' (command_name c ++ " " ++ s)-                      (extract_commands (command_sub_commands c))-            helper' s cs--man_trailer :: IO ()-man_trailer = do putStrLn ""-                 putStrLn ".SH BUGS"-                 putStrLn "Report bugs by mail to"-                 putStrLn ".B bugs@darcs.net"-                 putStrLn "or via the web site at"-                 putStrLn ".BR http://bugs.darcs.net/ ."-                 putStrLn ""-                 putStrLn ".SH AUTHOR"-                 putStrLn "David Roundy <droundy@abridgegame.org>."--man_header :: IO ()-man_header = do-  putStr ".TH DARCS \"1\" \""-  cl <- getClockTime-  ct <- toCalendarTime cl-  putStr $ show (ctMonth ct) ++ " " ++ show (ctYear ct)-  putStr "\" \"darcs\" \"User Commands\"\n"-  putStr $-   ".SH NAME\n"++-   "darcs \\- an advanced revision control system\n"++-   ".SH SYNOPSIS\n"++-   ".B darcs\n"++-   "\\fICOMMAND \\fR...\n"++-   ".SH DESCRIPTION\n"++-   "\n"++-   "darcs is a nifty revision control tool.  For more a detailed description,\n"++-   "see the html documentation, which should be available at\n"++-   "/usr/share/doc/darcs/manual/index.html.  To easily get more specific help\n"++-   "on each command, you can call `darcs COMMAND --help'.\n"++-   "\n"--
src/fpstring.c view
@@ -59,34 +59,6 @@  } -// mmapping...--#ifdef _WIN32--/* I have no idea if this works or not, and it is very tied to the usage- * of mmap in FastPackedString. Most arguments are ignored...- */--char *my_mmap(size_t length, int fd)-{-  exit(1); /* mmap is not implemented on Windows */-}--int munmap(void *start, size_t length)-{-    UnmapViewOfFile(start);-}--#else--char *my_mmap(size_t len, int fd) {-  void *maybeok = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, 0);-  if (maybeok == MAP_FAILED) return NULL;-  else return (char *)maybeok;-}--#endif- // ForeignPtr debugging stuff...  static int num_alloced = 0;
src/fpstring.h view
@@ -9,8 +9,6 @@ // int first_nonwhite(const char *s, int len); int has_funky_char(const char *s, int len); -char *my_mmap(size_t len, int fd);- int utf8_to_ints(HsInt *pwc, const unsigned char *s, int n);  void conv_to_hex(unsigned char *dest, unsigned char *from, int num_chars);
− src/hslibwww.c 
@@ -1,184 +0,0 @@-#ifdef HAVE_LIBWWW--#include "hslibwww.h"--#include <stdio.h>-#include <string.h>--static const char darcs_version[] = PACKAGE_VERSION;--#include <WWWLib.h>-#include <WWWInit.h>--enum RESULT_CODES-  {-    RESULT_OK = 0,-    RESULT_REQUEST_NEW_FAIL,-    RESULT_NET_ADD_AFTER_FAIL,-    RESULT_REQUEST_ADD_CACHE_CONTROL_FAIL,-    RESULT_LOAD_TO_FILE_FAIL,-    RESULT_MALLOC_FAIL,-    RESULT_LIST_NEW_FAIL,-    RESULT_LIST_APPEND_OBJECT_FAIL,-    RESULT_EVENTLIST_NEW_LOOP-  };--static const char *error_strings[] =-  {-    "",-    "HTRequest_new() failed",-    "HTNet_addAfter() failed",-    "HTRequest_addCacheControl() failed",-    "HTLoadToFile() failed",-    "malloc() failed",-    "HTList_new() failed",-    "HTList_appendObject() failed",-    "HTEventList_newLoop() failed"-  };--struct Completed-{-  int error;-  char *url;-};--static BOOL debug = NO;-static BOOL init_done = NO;-static int error;-static HTList *completed_list = NULL;-static char *last_url = NULL;-static char libwww_error[80];-static const char libwww_error_fmt[] = "libwww error code: %i";--int terminate_handler(HTRequest *request,-                      HTResponse *response,-                      void *param,-                      int status)-{-  struct Completed *completed = malloc(sizeof(struct Completed));-  if (completed == NULL)-    error = RESULT_MALLOC_FAIL;-  else-    {-      if (HTList_appendObject(completed_list, completed) == NO)-        {-          error = RESULT_LIST_APPEND_OBJECT_FAIL;-          free(completed);-        }-      else-        {-          error = RESULT_OK;-          completed->error = status;-          completed->url = HTRequest_context(request);-        }-    }--  HTRequest_delete(request);-  HTEventList_stopLoop();--  // Return not HT_OK to stop executing after filters.-  return HT_ERROR;-}--const char *libwww_request_url(const char *url,-                               const char *filename,-                               int cache_time)-{-  BOOL result;--  if (init_done == NO)-    {-      HTProfile_newNoCacheClient("darcs", darcs_version);-      HTProxy_getEnvVar();-      HTAlert_setInteractive(NO);-      HTFormat_addCoding("*", NULL, HTIdentityCoding, 1.0);-      if (debug == YES)-        HTSetTraceMessageMask("sop");-      init_done = YES;-    }--  if (completed_list == NULL)-    {-      completed_list = HTList_new();-      if (completed_list == NULL)-        return error_strings[RESULT_LIST_NEW_FAIL];-    }--  HTRequest *const request = HTRequest_new();-  if (request == NULL)-    return error_strings[RESULT_REQUEST_NEW_FAIL];--  HTRequest_setContext(request, strdup(url));--  result = HTNet_addAfter(terminate_handler, NULL, NULL, HT_ALL, HT_FILTER_LAST);-  if (result == NO)-    return error_strings[RESULT_NET_ADD_AFTER_FAIL];--  if (cache_time == 0)-    {-      HTRequest_addGnHd(request, HT_G_PRAGMA_NO_CACHE);-      result = HTRequest_addCacheControl(request, "no-cache", "");-    }-  else if (cache_time > 0)-    {-      char buf[8];-      snprintf(buf, sizeof(buf), "%d", cache_time);-      buf[sizeof(buf) - 1] = '\0';-      result = HTRequest_addCacheControl(request, "max-age", buf);-    }-  if (result == NO)-    return error_strings[RESULT_REQUEST_ADD_CACHE_CONTROL_FAIL];--  result = HTLoadToFile(url, request, filename);-  if (result == NO)-    return error_strings[RESULT_LOAD_TO_FILE_FAIL];--  return error_strings[RESULT_OK];-}--const char *libwww_wait_next_url()-{-  if (last_url != NULL)-    {-      free(last_url);-      last_url = NULL;-    }--  error = RESULT_OK;-  if (HTList_isEmpty(completed_list) == YES &&-      HTNet_isEmpty() == NO &&-      HTEventList_newLoop() != HT_OK)-    return error_strings[RESULT_EVENTLIST_NEW_LOOP];--  if (HTList_isEmpty(completed_list) == NO)-    {-      struct Completed *completed = HTList_firstObject(completed_list);-      if (completed->error == HT_LOADED)-        libwww_error[0] = '\0';-      else-        {-          snprintf(libwww_error, sizeof(libwww_error),-                   libwww_error_fmt, completed->error);-          libwww_error[sizeof(libwww_error) - 1] = '\0';-        }-      last_url = completed->url;-      HTList_removeFirstObject(completed_list);-      free(completed);--      return libwww_error;-    }--  return error_strings[error];-}--const char *libwww_last_url()-{-  return last_url != NULL ? last_url : "";-}--void libwww_enable_debug()-{-  debug = YES;-}--#endif
− src/hslibwww.h 
@@ -1,9 +0,0 @@-const char *libwww_request_url(const char *url,-                               const char *filename,-                               int cache_time);--const char *libwww_wait_next_url();--const char *libwww_last_url();--void libwww_enable_debug();
src/impossible.h view
@@ -1,9 +1,8 @@-import qualified HTTP as HTTP_ import qualified Darcs.Bug as Bug_  #define darcsBug (\imp_funny_name -> imp_funny_name (__FILE__,__LINE__,__TIME__,__DATE__)) -#define bug        (darcsBug (Bug_._bug HTTP_.fetchUrl))-#define impossible (darcsBug (Bug_._impossible HTTP_.fetchUrl))-#define fromJust   (darcsBug (Bug_._fromJust HTTP_.fetchUrl))-#define bugDoc     (darcsBug (Bug_._bugDoc HTTP_.fetchUrl))+#define bug        (darcsBug Bug_._bug)+#define impossible (darcsBug Bug_._impossible)+#define fromJust   (darcsBug Bug_._fromJust)+#define bugDoc     (darcsBug Bug_._bugDoc)
src/preproc.hs view
@@ -1,8 +1,22 @@+-- | This program mangles a pseudo-LaTeX document into actual LaTeX.+-- There are three key changes to the input:+--+--   * \\input{foo} is replaced by the contents of the file foo (after+--     it, too, is mangled).  Note that this is relative to the+--     working directory, *not* relative to the file being parsed.+--+--   * Anything between \\begin{code} and \\end{code} is deleted.+--     Note that this is quite unlike normal literate documentation+--     (for which we use Haddock, not LaTeX).+--+--   * Some nonstandard pseudo-LaTeX commands are expanded into actual+--     LaTeX text.  In particular, \\darcsCommand{foo} is replaced by+--     LaTeX markup describing the command @foo@.+module Main (main) where import System.FilePath ( (</>) ) import System.Environment ( getArgs ) import System.Exit ( exitWith, ExitCode(..) ) import Text.Regex ( matchRegex, mkRegex )- import Darcs.Commands ( DarcsCommand(SuperCommand,                         command_sub_commands, command_name,                         command_extra_arg_help, command_basic_options,@@ -10,12 +24,17 @@                         command_description),                         extract_commands ) import Darcs.Arguments ( options_latex )-import Darcs.Commands.Help ( command_control_list )-import Autoconf ( darcs_version )+import Darcs.Commands.Help ( command_control_list, environmentHelp )+import English ( andClauses )+import ThisVersion ( darcs_version )  the_commands :: [DarcsCommand] the_commands = extract_commands command_control_list +-- | The entry point for this program.  The path to the TeX master+-- file is supplied as the first argument.  Bootstrapping into+-- 'preproc' then happens by passing it a pseudo-document that+-- contains a single input (include) line. main :: IO () main = do   args <- getArgs@@ -26,19 +45,28 @@   c <- preproc ["\\input{"++head args++"}"]   mapM_ putStrLn c +-- | Depending on whether pdflatex or htlatex is to be used, the LaTeX+-- output of this program must vary subtly.  This procedure returns+-- true iff the command-line arguments contain @--html@. am_html :: IO Bool am_html = do args <- getArgs-             case args of-               [_,"--html"] -> return True-               _ -> return False+             return $ elem "--html" args +-- | Given a list of input lines in pseudo-LaTeX, return the same+-- document in LaTeX.  The pseudo-LaTeX lines are replaced, other+-- lines are used unmodified. preproc :: [String] -> IO [String]+preproc [] = return []              -- Empty input, empty output. preproc ("\\usepackage{html}":ss) = -- only use html package with latex2html     do rest <- preproc ss        ah <- am_html        if ah then return $ "\\usepackage{html}" : rest              else return $ "\\usepackage{hyperref}" : rest preproc ("\\begin{code}":ss) = ignore ss+    where ignore :: [String] -> IO [String]+          ignore ("\\end{code}":ss') = preproc ss'+          ignore (_:ss') = ignore ss'+          ignore [] = return [] preproc ("\\begin{options}":ss) =     do rest <- preproc ss        ah <- am_html@@ -50,35 +78,38 @@        ah <- am_html        if ah then return $ "</div>" : "\\end{rawhtml}" : rest              else return $ "\\end{Verbatim}" : rest+preproc ("\\darcsVersion":ss) = do+  rest <- preproc ss+  return $ darcs_version:rest preproc (s:ss) = do   rest <- preproc ss-  case matchRegex (mkRegex "^\\\\input\\{(.+)\\}$") s of-    Just (fn:_) -> do cs <- readFile $ "src" </> fn -- ratify readFile: not part of-                                        -- darcs executable-                      this <- preproc $ lines cs-                      return $ this ++ rest-    _ -> case matchRegex (mkRegex "^(.*)\\\\haskell\\{(.+)\\}(.*)$") s of-         Just (before:var:after:_) ->-             case breakLast '_' var of-             (cn,"help") -> return $ (before++gh cn++after):rest-             (cn,"description") -> return $ (before++gd cn++after):rest-             ("darcs","version") -> return $ (before++darcs_version++after):rest-             aack -> error $ show aack-         _ -> case matchRegex (mkRegex "^(.*)\\\\options\\{(.+)\\}(.*)$") s of-              Just (before:comm:after:_) ->-                  return $ (before++get_options comm++after):rest-              _ ->  case matchRegex (mkRegex "^(.*)\\\\example\\{(.+)\\}(.*)$") s of-                    Just (before:fn:after:_) -> do-                        filecont <- readFile fn -- ratify readFile: not part of-                                                -- darcs executable-                        return $ (before++"\\begin{verbatim}"++-                                  filecont++"\\end{verbatim}"-                                  ++after):rest-                    _ -> return $ s : rest-  where breakLast chr str = (reverse $ tail l, reverse f)-            where (f, l) = break (==chr) $ reverse str+  let rx = mkRegex "^\\\\(input|darcs(Command|Env))\\{(.+)\\}$"+  case matchRegex rx s of+    Just ["input", _, path] ->+        do cs <- readFile $ "src" </> path -- ratify readFile: not part of darcs executable+           this <- preproc $ lines cs+           return $ this ++ rest+    Just ["darcsCommand", _, command] ->+        return $ commandHelp command : rest+    Just ["darcsEnv", _, variable] ->+        return $ envHelp variable : rest+    -- The base case for the whole preproc function.  Nothing to+    -- mangle, so this is an ordinary line of TeX, and we append it to+    -- the result unmodified.+    _ -> return $ s : rest -preproc [] = return []+commandHelp :: String -> String+commandHelp command = section ++ "{darcs " ++ command ++ "}\n" +++                      "\\label{" ++ command ++ "}\n" +++                      gh ++ get_options command ++ gd+    where+      section = if ' ' `elem` command then "\\subsubsection" else "\\subsection"+      -- | Given a Darcs command name as a string, return that command's (multi-line) help string.+      gh :: String+      gh =  escape_latex_specials $ command_property command_help the_commands command+      -- | Given a Darcs command name as a string, return that command's (one-line) description string.+      gd :: String+      gd = command_property command_description the_commands command  get_options :: String -> String get_options comm = get_com_options $ get_c names the_commands@@ -100,7 +131,7 @@  get_com_options :: [DarcsCommand] -> String get_com_options c =-    "\\verb!Usage: darcs " ++ cmd ++ " [OPTION]... " +++    "\\par\\verb!Usage: darcs " ++ cmd ++ " [OPTION]... " ++     args ++ "!\n\n" ++ "Options:\n\n" ++ options_latex opts1 ++     (if null opts2 then "" else "\n\n" ++ "Advanced options:\n\n" ++ options_latex opts2)     where cmd = unwords $ map command_name c@@ -108,25 +139,46 @@           opts1 = command_basic_options $ last c           opts2 = command_advanced_options $ last c -ignore :: [String] -> IO [String]-ignore ("\\end{code}":ss) = preproc ss-ignore (_:ss) = ignore ss-ignore [] = return []- command_property :: (DarcsCommand -> String) -> [DarcsCommand] -> String                  -> String command_property property commands name =     property $ last c-    where words_ :: String -> [String] -- "word" with '_' instead of spaces-          words_ s =-              case dropWhile (=='_') s of-                       "" -> []-                       s' -> w : words_ s''-                           where (w, s'') = break (=='_') s'-          names = words_ name+    where names = words name           c = get_c names commands -gh :: String -> String-gh = command_property command_help the_commands-gd :: String -> String-gd = command_property command_description the_commands+++envHelp :: String -> String+envHelp var = unlines $ render $ entry environmentHelp+    where render (ks, ds) =+              ("\\paragraph{" ++ escape_latex_specials (andClauses ks) ++ "}") :+              ("\\label{env:" ++ var ++ "}") :+              map escape_latex_specials ds+          entry [] = undefined+          entry (x:xs) | elem var $ fst x = x+                       | otherwise = entry xs++-- | LaTeX treats a number of characters or sequences specially.+-- Therefore when including ordinary help text in a LaTeX document, it+-- is necessary to escape these characters in the way LaTeX expects.+escape_latex_specials :: String -> String+-- Order is important+escape_latex_specials =+  (bs2 . amp . percent . carrot . dollar . underscore . rbrace . lbrace . bs1)+  where+    amp        = replace "&"  "\\&"+    bs1        = replace "\\" "\001"+    bs2        = replace "\001" "$\\backslash$"+    carrot     = replace "^"  "\\^{}"+    dollar     = replace "$"  "\\$"+    lbrace     = replace "{"  "\\{"+    percent    = replace "%"  "\\%"+    rbrace     = replace "}"  "\\}"+    underscore = replace "_"  "\\_"++    replace :: Eq a => [a] -> [a] -> [a] -> [a]+    replace _ _ [] = []+    replace find repl s =+        if take (length find) s == find+            then repl ++ (replace find repl (drop (length find) s))+            else [head s] ++ replace find repl (tail s)
src/switching.tex view
@@ -69,7 +69,7 @@  Tools and instructions for migrating CVS repositories to darcs are provided on the darcs community website: -\htmladdnormallinkfoot{http://darcs.net/DarcsWiki/ConvertingFromCvs}{http://darcs.net/DarcsWiki/ConvertingFromCvs}+\htmladdnormallinkfoot{http://wiki.darcs.net/DarcsWiki/ConvertingFromCvs}{http://wiki.darcs.net/DarcsWiki/ConvertingFromCvs}   \section{Switching from arch}@@ -118,7 +118,7 @@ \item[{\tt tla add}\hspace*{100em}]    {\tt darcs add} \item[{\tt tla mv}\hspace*{100em}]-   {\tt darcs mv}+   {\tt darcs move}       (not {\tt tla move}) \item[{\tt tla commit}\hspace*{100em}]    {\tt darcs record}@@ -143,5 +143,5 @@  Tools and instructions for migrating arch repositories to darcs are provided on the darcs community website: -\htmladdnormallinkfoot{http://darcs.net/DarcsWiki/ConvertingFromArch}{http://darcs.net/DarcsWiki/ConvertingFromArch}+\htmladdnormallinkfoot{http://wiki.darcs.net/DarcsWiki/ConvertingFromArch}{http://wiki.darcs.net/DarcsWiki/ConvertingFromArch}
src/unit.lhs view
@@ -46,19 +46,17 @@  module Main (main) where -import Control.Monad (when) import System.IO.Unsafe ( unsafePerformIO )-import ByteStringUtils+import ByteStringUtils hiding ( intercalate ) import qualified Data.ByteString.Char8 as BC ( unpack, pack )-import qualified Data.ByteString as B ( empty, concat )+import qualified Data.ByteString as B ( empty, concat, length, unpack, foldr,+                                        cons, ByteString, null, filter, head )+import Data.Char ( isPrint ) import Darcs.Patch import Darcs.Patch.Test-import Darcs.Patch.Unit ( run_patch_unit_tests )+import Darcs.Patch.Unit ( patch_unit_tests ) import Lcs ( shiftBoundaries ) import Test.QuickCheck-import System ( ExitCode(..), exitWith )-import System.IO ( hSetBuffering, stdout, BufferMode(..) )-import Data.IORef ( IORef, newIORef, readIORef, modifyIORef ) import Printer ( renderPS, text ) import Darcs.Patch.Commute import Data.Array.Base@@ -66,8 +64,13 @@ import Control.Monad.ST import Darcs.Ordered import Darcs.Sealed ( Sealed(Sealed), unsafeUnseal )+import Darcs.Email ( make_email, read_email, formatHeader )+import Test.HUnit ( assertBool, assertFailure )+import Test.Framework.Providers.QuickCheck2 ( testProperty )+import Test.Framework.Providers.HUnit ( testCase )+import Test.Framework.Runners.Console ( defaultMain )+import Test.Framework ( Test ) -import Darcs.Email ( make_email, read_email ) #include "impossible.h" \end{code} @@ -76,126 +79,87 @@ \begin{code} main :: IO () main = do-  hSetBuffering stdout NoBuffering-  returnval <- newIORef 0-  patch_failures <- run_patch_unit_tests-  if patch_failures > 0-      then do putStrLn $ show patch_failures ++ " failures in Darcs.Patch.Unit."-              exitWith $ ExitFailure 1-      else putStrLn "No failures in Darcs.Patch.Unit."-  when (unpackPSfromUTF8 (BC.pack "hello world") /= "hello world") $-       do putStr "Problem with unpackPSfromUTF8\n"-          putStr $ "hello world isn't '" ++-                 unpackPSfromUTF8 (BC.pack "hello world")++"'\n"-          exitWith $ ExitFailure 1-  when (BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world")-        /= "hello world") $-       do putStr "Problem with binary to hex conversion and back again\n"-          exitWith $ ExitFailure 1-  putStr "Checking that email can be parsed... "-  quickCheck $ \s ->-      unlines ("":s++["", ""]) ==-              BC.unpack (read_email (renderPS-                       $ make_email "reponame" [] (Just (text "contents\n"))-                       (text $ unlines s) (Just "filename")))-  --putStr $ test_patch-  --exitWith ExitSuccess-  case run_tests returnval of-    run -> do-      putStr ("There are a total of "++(show (length primitive_test_patches))-              ++" primitive patches.\n")-      putStr ("There are a total of "++-              (show (length test_patches))++" patches.\n")-      putStr "Checking that B.concat works... "-      quickCheck prop_concatPS-      putStr "Checking that hex conversion works... "-      quickCheck prop_hex_conversion-      putStr "Checking that show and read work right... "-      quickCheck prop_read_show-      run "Checking known commutes... " commute_tests-      run "Checking known merges... " merge_tests-      run "Checking known canons... " canonization_tests-      check_subcommutes subcommutes_inverse "patch and inverse both commutex"-      check_subcommutes subcommutes_nontrivial_inverse-                            "nontrivial commutes are correct"-      check_subcommutes subcommutes_failure "inverses fail"-      putStr "Checking that commuting by patch and its inverse is ok... "-      quickCheck prop_commute_inverse-      --putStr "Checking that conflict resolution is valid... "-      --quickCheck prop_resolve_conflicts_valid-      putStr "Checking that a patch followed by its inverse is identity... "-      quickCheck prop_patch_and_inverse_is_identity-      -- The following tests are "wrong" with the Conflictor code.-      --putStr "Checking that a simple smart_merge is sufficient... "-      --quickCheck prop_simple_smart_merge_good_enough-      --putStr "Checking that an elegant merge is sufficient... "-      --quickCheck prop_elegant_merge_good_enough-      putStr "Checking that commutes are equivalent... "-      quickCheck prop_commute_equivalency-      putStr "Checking that merges are valid... "-      quickCheck prop_merge_valid-      putStr "Checking inverses being valid... "-      quickCheck prop_inverse_valid-      putStr "Checking other inverse being valid... "-      quickCheck prop_other_inverse_valid-      run "Checking merge swaps... " merge_swap_tests-      -- The patch generator isn't smart enough to generate correct test-      -- cases for the following: (which will be obsoleted soon, anyhow)-      --putStr "Checking the order dependence of unravel... "-      --quickCheck prop_unravel_order_independent-      --putStr "Checking the unravelling of three merges... "-      --quickCheck prop_unravel_three_merge-      --putStr "Checking the unravelling of a merge of a sequence... "-      --quickCheck prop_unravel_seq_merge-      putStr "Checking inverse of inverse... "-      quickCheck prop_inverse_composition-      putStr "Checking the order of commutes... "-      quickCheck prop_commute_either_order-      putStr "Checking commutex either way... "-      quickCheck prop_commute_either_way-      putStr "Checking the double commutex... "-      quickCheck prop_commute_twice-      putStr "Checking that merges commutex and are well behaved... "-      quickCheck prop_merge_is_commutable_and_correct-      putStr "Checking that merges can be swapped... "-      quickCheck prop_merge_is_swapable-      putStr "Checking again that merges can be swapped (I'm paranoid) ... "-      quickCheck prop_merge_is_swapable-      run "Checking that the patch validation works... " test_check-      run "Checking commutex/recommute... " commute_recommute_tests-      run "Checking merge properties... " generic_merge_tests-      run "Testing the lcs code... " show_lcs_tests-      run "Checking primitive patch IO functions... " primitive_show_read_tests-      run "Checking IO functions... " show_read_tests-      run "Checking primitive commutex/recommute... "-          primitive_commute_recommute_tests-      trv <- readIORef returnval-      if trv == 0-         then exitWith ExitSuccess-         else exitWith $ ExitFailure trv-\end{code}--\section{run\_tests}+    putStr ("There are a total of "++(show (length primitive_test_patches))+            ++" primitive patches.\n")+    putStr ("There are a total of "+++            (show (length test_patches))++" patches.\n")+    defaultMain tests -run\_tests is used to run a series of tests (which return a list of strings-describing their failures) and then update n IORef so the program can exit-with an error if one of the tests failed.+-- | Utility function to run bools with test-framework+testBool :: String -> Bool -> Test+testBool name test = testCase name (assertBool assertName test)+  where assertName = "boolean test \"" ++ name ++ "\" should return True" -\begin{code}-run_tests :: (IORef Int) -> String -> [String] -> IO ()-run_tests return_val s ss = do-    putStr s-    if null ss-       then putStr "good.\n"-       else do modifyIORef return_val (+1)-               print_strings ss-               exitWith $ ExitFailure 1+-- | Utility function to run old tests that return a list of error messages,+--   with the empty list meaning success.+testStringList :: String -> [String] -> Test+testStringList name test = testCase name $ mapM_ assertFailure test -print_strings :: [String] -> IO ()-print_strings [] = return ()-print_strings (s:ss) = do-  putStr s-  print_strings ss+-- | This is the big list of tests that will be run using testrunner.+tests :: [Test]+tests = patch_unit_tests +++        [testBool "Checking that UTF-8 packing and unpacking preserves 'hello world'"+                  (unpackPSfromUTF8 (BC.pack "hello world") == "hello world"),+         testBool "Checking that hex packing and unpacking preserves 'hello world'"+                  (BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world")+                       == "hello world"),+         testProperty "Checking that email can be parsed"+          (\s ->+            unlines ("":s++["", ""]) ==+              BC.unpack (read_email (renderPS+                    $ make_email "reponame" [] (Just (text "contents\n"))+                                 (text $ unlines s) (Just "filename")))),+         testProperty "Checking email header line length" email_header_no_long_lines,+         testProperty "Checking email for illegal characters" email_header_ascii_chars,+         testProperty "Checking for spaces at start of folded email header lines" email_header_lines_start,+         testProperty "Checking that there are no empty lines in email headers" email_header_no_empty_lines,+         testProperty "Checking that B.concat works" prop_concatPS,+         testProperty "Checking that hex conversion works" prop_hex_conversion,+         testProperty "Checking that show and read work right" prop_read_show,+         testStringList "Checking known commutes" commute_tests,+         testStringList "Checking known merges" merge_tests,+         testStringList "Checking known canons" canonization_tests]+        ++ check_subcommutes subcommutes_inverse "patch and inverse both commutex"+        ++ check_subcommutes subcommutes_nontrivial_inverse "nontrivial commutes are correct"+        ++ check_subcommutes subcommutes_failure "inverses fail"+        +++        [testProperty "Checking that commuting by patch and its inverse is ok" prop_commute_inverse,+         --putStr "Checking that conflict resolution is valid... "+         --runQuickCheckTest returnval prop_resolve_conflicts_valid+         testProperty "Checking that a patch followed by its inverse is identity" prop_patch_and_inverse_is_identity,+         -- The following tests are "wrong" with the Conflictor code.+         --putStr "Checking that a simple smart_merge is sufficient... "+         --runQuickCheckTest returnval prop_simple_smart_merge_good_enough+         --putStr "Checking that an elegant merge is sufficient... "+         --runQuickCheckTest returnval prop_elegant_merge_good_enough+         testProperty "Checking that commutes are equivalent" prop_commute_equivalency,+         testProperty "Checking that merges are valid" prop_merge_valid,+         testProperty "Checking inverses being valid" prop_inverse_valid,+         testProperty "Checking other inverse being valid" prop_other_inverse_valid,+         testStringList "Checking merge swaps" merge_swap_tests,+         -- The patch generator isn't smart enough to generate correct test+         -- cases for the following: (which will be obsoleted soon, anyhow)+         --putStr "Checking the order dependence of unravel... "+         --runQuickCheckTest returnval prop_unravel_order_independent+         --putStr "Checking the unravelling of three merges... "+         --runQuickCheckTest returnval prop_unravel_three_merge+         --putStr "Checking the unravelling of a merge of a sequence... "+         --runQuickCheckTest returnval prop_unravel_seq_merge+         testProperty "Checking inverse of inverse" prop_inverse_composition,+         testProperty "Checking the order of commutes" prop_commute_either_order,+         testProperty "Checking commutex either way" prop_commute_either_way,+         testProperty "Checking the double commutex" prop_commute_twice,+         testProperty "Checking that merges commutex and are well behaved" prop_merge_is_commutable_and_correct,+         testProperty "Checking that merges can be swapped" prop_merge_is_swapable,+         testProperty "Checking again that merges can be swapped (I'm paranoid) " prop_merge_is_swapable,+         testStringList "Checking that the patch validation works" test_check,+         testStringList "Checking commutex/recommute" commute_recommute_tests,+         testStringList "Checking merge properties" generic_merge_tests,+         testStringList "Testing the lcs code" show_lcs_tests,+         testStringList "Checking primitive patch IO functions" primitive_show_read_tests,+         testStringList "Checking IO functions" show_read_tests,+         testStringList "Checking primitive commutex/recommute" primitive_commute_recommute_tests+        ] \end{code}  \chapter{Unit Tester}@@ -207,9 +171,6 @@ \begin{code} type PatchUnitTest p = p -> [String] type TwoPatchUnitTest = Patch -> Patch -> [String]-unit_tester :: PatchUnitTest p -> [p] -> [String]-unit_tester _ []        = []-unit_tester thetest (p:ps) = (thetest p)++(unit_tester thetest ps)  parallel_pair_unit_tester :: TwoPatchUnitTest -> [(Patch:\/:Patch)] -> [String] parallel_pair_unit_tester _ []        = []@@ -222,6 +183,54 @@     = (thetest p1 p2)++(pair_unit_tester thetest ps) \end{code} +\chapter{Email format tests}++These tests check whether the emails generated by darcs meet a few criteria.+We check for line length and non-ASCII characters. We apparently do not have to+check for CR-LF newlines because that's handled by sendmail.++\begin{code}++-- Check that formatHeader never creates lines longer  than 78 characters+-- (excluding the carriage return and line feed)+email_header_no_long_lines :: String -> String -> Bool+email_header_no_long_lines field value =+    not $ any (>78) $ map B.length $ bs_lines $ formatHeader cleanField value+  where cleanField = clean_field_string field++bs_lines :: B.ByteString -> [B.ByteString]+bs_lines = finalizeFold . B.foldr splitAtLines (B.empty, [])+  where splitAtLines 10 (thisLine, prevLines) = (B.empty, thisLine:prevLines)+        splitAtLines c  (thisLine, prevLines) = (B.cons c thisLine, prevLines)+        finalizeFold (lastLine, otherLines) = lastLine : otherLines++-- Check that an email header does not contain non-ASCII characters+-- formatHeader doesn't escape field names, there is no such thing as non-ascii+-- field names afaik+email_header_ascii_chars :: String -> String -> Bool+email_header_ascii_chars field value+    = not (any (>127) (B.unpack (formatHeader cleanField value)))+  where cleanField = clean_field_string field++-- Check that header the second and later lines of a header start with a space+email_header_lines_start :: String -> String -> Bool+email_header_lines_start field value =+    all (\l -> B.null l || B.head l == 32) (tail headerLines)+  where headerLines = bs_lines (formatHeader cleanField value)+        cleanField  = clean_field_string field++-- Checks that there are no lines in email headers with only whitespace+email_header_no_empty_lines :: String -> String -> Bool+email_header_no_empty_lines field value =+    all (not . B.null . B.filter (not . (`elem` [10, 32, 9]))) headerLines+  where headerLines = bs_lines (formatHeader cleanField value)+        cleanField  = clean_field_string field++clean_field_string :: String -> String+clean_field_string = filter (\c -> isPrint c && c < '\x80' && c /= ':')++\end{code}+ \chapter{LCS}  Here are a few quick tests of the shiftBoundaries function.@@ -230,7 +239,7 @@ show_lcs_tests :: [String] show_lcs_tests = concatMap check_known_shifts known_shifts check_known_shifts :: ([Int],[Int],String,String,[Int],[Int])-                   -> [String] +                   -> [String] check_known_shifts (ca, cb, sa, sb, ca', cb') = runST (     do ca_arr <- newListArray (0, length ca) $ toBool (0:ca)        cb_arr <- newListArray (0, length cb) $ toBool (0:cb)@@ -273,10 +282,10 @@  \begin{code} show_read_tests :: [String]-show_read_tests = unit_tester t_show_read test_patches ++-                  unit_tester t_show_read test_patches_named+show_read_tests = concatMap t_show_read test_patches +++                  concatMap t_show_read test_patches_named primitive_show_read_tests :: [String]-primitive_show_read_tests = unit_tester t_show_read primitive_test_patches+primitive_show_read_tests = concatMap t_show_read primitive_test_patches t_show_read :: (Eq p, Show p, Patchy p) => PatchUnitTest p t_show_read p =     case readPatch $ renderPS $ showPatch p of@@ -785,7 +794,7 @@                                 quickhunk 1 "b" "d"])]++test_patches  test_check :: [String]-test_check = unit_tester t_test_check valid_patches+test_check = concatMap t_test_check valid_patches t_test_check :: PatchUnitTest Patch t_test_check p = if check_a_patch p                  then []@@ -797,12 +806,15 @@ prop_concatPS :: [String] -> Bool prop_concatPS ss = concat ss == BC.unpack (B.concat $ map BC.pack ss) -check_subcommutes :: Testable a => [(String, a)] -> String -> IO ()-check_subcommutes [] _ = return ()-check_subcommutes ((n,c):r) expl =-    do putStr $ "Checking " ++ expl ++ " for subcommute " ++ n ++ "... "-       quickCheck c-       check_subcommutes r expl+-- | Groups a set of tests by giving them the same prefix in their description.+--   When this is called as @check_subcommutes subcoms expl@, the prefix for a+--   test becomes @"Checking " ++ expl ++ " for subcommute "@.+check_subcommutes :: Testable a => [(String, a)] -> String+                                                 -> [Test]+check_subcommutes subcoms expl = map check_subcommute subcoms+  where check_subcommute (name, test) =+            let testName = "Checking" ++ expl ++ " for subcommute " ++ name+            in testProperty testName test \end{code}  \end{document}
src/win32/System/Posix/Files.hsc view
@@ -2,16 +2,16 @@ module System.Posix.Files where  import Foreign.Marshal.Alloc ( allocaBytes )-import Foreign.C.Error ( throwErrnoIfMinus1Retry )-import Foreign.C.String ( withCString )+import Foreign.C.Error ( throwErrnoIfMinus1Retry, throwErrnoPathIf_ )+import Foreign.C.String ( withCString, withCWString, CWString ) import Foreign.C.Types ( CTime, CInt )-import Foreign.Ptr ( Ptr )+import Foreign.Ptr ( Ptr, nullPtr )  import System.Posix.Internals           ( FDType, CStat, c_fstat, lstat,              sizeof_stat, statGetType,              st_mode, st_size, st_mtime,-            s_isreg, s_isdir, s_isfifo, )+            s_isreg, s_isdir, s_isfifo, c_stat ) import System.Posix.Types ( Fd(..), CMode, EpochTime, FileMode )  import Data.Bits ( (.|.) )@@ -69,12 +69,9 @@ fileSize :: FileStatus -> FileOffset fileSize = fst_size -fileMode :: () -> ()+fileMode :: a -> () fileMode _ = () -getFileStatus :: FilePath -> IO ()-getFileStatus _ = return ()- setFileMode :: FilePath -> () -> IO () setFileMode _ _ = return () @@ -82,12 +79,23 @@ stdFileMode :: FileMode stdFileMode = (#const S_IRUSR) .|. (#const S_IWUSR) -+getFileStatus :: FilePath -> IO FileStatus+getFileStatus fp =+  do_stat (\p -> (fp `withCString` (`c_stat` p))) +-- lstat is broken on win32 with at least GHC 6.10.3 getSymbolicLinkStatus :: FilePath -> IO FileStatus-getSymbolicLinkStatus fp = +##if mingw32_HOST_OS+getSymbolicLinkStatus = getFileStatus+##else+getSymbolicLinkStatus fp =   do_stat (\p -> (fp `withCString` (`lstat` p)))+##endif --- Dummy implementation of createLink.+#define _WIN32_WINNT 0x0500+foreign import stdcall "winbase.h CreateHardLinkW" c_CreateHardLink :: CWString -> CWString -> Ptr a -> IO CInt+ createLink :: FilePath -> FilePath -> IO ()-createLink _ _ = fail "Dummy create link error should be caught."+createLink old new = withCWString old $ \c_old -> withCWString new $ \c_new ->+	throwErrnoPathIf_ (==0) "createLink" new $+		c_CreateHardLink c_new c_old nullPtr
+ src/win32/send_email.c view
@@ -0,0 +1,211 @@+++#include <windows.h>+#include <mapi.h>+#include <stdio.h>++#include "send_email.h"++typedef struct sMapiFuns {+    LPMAPILOGON logon;+    LPMAPISENDMAIL sendmail;+    LPMAPIRESOLVENAME resolve;+    LPMAPIFREEBUFFER free_buf;+    LPMAPILOGOFF logoff;+    HMODULE dll;+} MapiFuns;+++int load_dll(const char* name, MapiFuns* funs);+void free_dll(MapiFuns* funs);++void get_recipient(MapiFuns* funs, const char *name, ULONG recipClass, MapiRecipDesc *desc, lpMapiRecipDesc *desc_lookup);++int send_email(const char *sendname, +               const char *recvname, +               const char *ccname, +               const char *subj,+               const char *body,+               const char *path)+{+    FLAGS flags;+    MapiMessage msg;+    ULONG send_res;+    MapiRecipDesc orig;+    MapiRecipDesc recips[2];+    MapiRecipDesc *orig_lookup, *recip_lookup, *cc_lookup;+    int num_recip = 1, return_code = -1;+    MapiFileDesc attachment;+    MapiFileTagExt file_type;+    const char *filename;+    char *attachment_path = 0;+    MapiFuns funs;+    +    if(load_dll("mapistub.dll", &funs) || load_dll("mapi32.dll", &funs)) {+        return_code=0;+    } else {+        fprintf(stderr, "Unable to load mapistub.dll or mapi32.dll: Bailing out. \n");+        return_code=-1;+    }++    if(return_code==0) {+        LHANDLE session;+        /* logon seems to be necessary for outlook express, sometimes,+        and doesn't seem to hurt, otherwise.+        */+        funs.logon(0, 0, 0, MAPI_LOGON_UI, 0, &session);++        +        orig_lookup = recip_lookup = cc_lookup = NULL;+        +        get_recipient(&funs, sendname, MAPI_ORIG, &orig, &orig_lookup);+        get_recipient(&funs, recvname, MAPI_TO, &recips[0], &recip_lookup);++        if (ccname && strlen(ccname) > 0) {+            get_recipient(&funs, ccname, MAPI_CC, &recips[1], &cc_lookup);+            num_recip++;+        }++        memset(&msg, 0, sizeof(msg));+        msg.lpOriginator = &orig;+        msg.lpRecips = recips;+        msg.lpszMessageType = "text/plain";+        msg.lpszNoteText = (LPSTR) body;+        msg.lpszSubject = (LPSTR)subj;+        msg.nRecipCount = num_recip;+        msg.flFlags = 0;++        if (path) {+            attachment_path = strdup(path);+            /* convert / to \  (thunderbird doesn't like /) */+            char *p = attachment_path;+            while ((p = strchr(p, '/')))+                *p = '\\';++            /* find filename */+            filename = strrchr(attachment_path, '\\');+            if (filename == 0)+                filename = attachment_path;+            else+                filename++;++            memset(&attachment, 0, sizeof(attachment));+            attachment.nPosition = -1;+            attachment.lpszPathName = (LPTSTR)attachment_path;+            attachment.lpszFileName = (LPTSTR)filename;++            attachment.lpFileType = &file_type;+            +            memset(&file_type, 0, sizeof(file_type));+            file_type.lpTag = "text/plain";+            file_type.cbTag = sizeof(file_type.lpTag);++            msg.nFileCount = 1;+            msg.lpFiles = &attachment;+        }++        flags = 0;+        send_res = funs.sendmail(0, 0, &msg, flags, 0);++        if (send_res == SUCCESS_SUCCESS)+            return_code = 0;+        else {+            return_code=-1;+            if(send_res==MAPI_E_USER_ABORT)                 fprintf(stderr, "MAPI error: User aborted.\n");+            else if(send_res== MAPI_E_FAILURE)              fprintf(stderr, "MAPI error: Generic error.\n");+            else if(send_res== MAPI_E_LOGIN_FAILURE)        fprintf(stderr, "MAPI error: Login failure.\n");+            else if(send_res== MAPI_E_DISK_FULL)            fprintf(stderr, "MAPI error: Disk full.\n");+            else if(send_res== MAPI_E_INSUFFICIENT_MEMORY)  fprintf(stderr, "MAPI error: Insufficient memory.\n");+            else if(send_res== MAPI_E_ACCESS_DENIED)        fprintf(stderr, "MAPI error: Access denied.\n");+            else if(send_res== MAPI_E_TOO_MANY_SESSIONS)    fprintf(stderr, "MAPI error: Too many sessions\n");+            else if(send_res== MAPI_E_TOO_MANY_FILES)       fprintf(stderr, "MAPI error: Too many files.\n");+            else if(send_res== MAPI_E_TOO_MANY_RECIPIENTS)  fprintf(stderr, "MAPI error: Too many recipients.\n");+            else if(send_res== MAPI_E_ATTACHMENT_NOT_FOUND) fprintf(stderr, "MAPI error: Attachment not found.\n");+            else if(send_res== MAPI_E_ATTACHMENT_OPEN_FAILURE)  fprintf(stderr, "MAPI error: Failed to open attachment.\n");+            else if(send_res== MAPI_E_ATTACHMENT_WRITE_FAILURE) fprintf(stderr, "MAPI error: Failed to write attachment.\n");+            else if(send_res== MAPI_E_UNKNOWN_RECIPIENT)    fprintf(stderr, "MAPI error: Unknown recipient\n");+            else if(send_res== MAPI_E_BAD_RECIPTYPE)        fprintf(stderr, "MAPI error: Bad type of recipent.\n");+            else if(send_res== MAPI_E_NO_MESSAGES)          fprintf(stderr, "MAPI error: No messages.\n");+            else if(send_res== MAPI_E_INVALID_MESSAGE)      fprintf(stderr, "MAPI error: Invalid message.\n");+            else if(send_res== MAPI_E_TEXT_TOO_LARGE)       fprintf(stderr, "MAPI error: Text too large.\n");+            else if(send_res== MAPI_E_INVALID_SESSION)      fprintf(stderr, "MAPI error: Invalid session.\n");+            else if(send_res== MAPI_E_TYPE_NOT_SUPPORTED)   fprintf(stderr, "MAPI error: Type not supported.\n");+            else if(send_res== MAPI_E_AMBIGUOUS_RECIP)      fprintf(stderr, "MAPI error: Ambigious recipient.\n");+            else if(send_res== MAPI_E_MESSAGE_IN_USE)       fprintf(stderr, "MAPI error: Messag in use.\n");+            else if(send_res== MAPI_E_NETWORK_FAILURE)      fprintf(stderr, "MAPI error: Network failure.\n");+            else if(send_res== MAPI_E_INVALID_EDITFIELDS)   fprintf(stderr, "MAPI error: Invalid editfields\n");+            else if(send_res== MAPI_E_INVALID_RECIPS)       fprintf(stderr, "MAPI error: Invalid recipient(s)\n");+            else if(send_res== MAPI_E_NOT_SUPPORTED)        fprintf(stderr, "MAPI error: Operation not supported.\n");+            else fprintf(stderr, "MAPISendMail returned %ld\n", send_res);+        }++        +        if (orig_lookup) funs.free_buf(orig_lookup);+        if (recip_lookup) funs.free_buf(recip_lookup);+        if (cc_lookup) funs.free_buf(cc_lookup);+        if (attachment_path) free(attachment_path);++        funs.logoff(session, 0, 0, 0);+    }+    free_dll(&funs);+    return return_code;+}++void get_recipient(MapiFuns* funs, const char *name, ULONG recipClass, MapiRecipDesc *desc, lpMapiRecipDesc *desc_lookup) {+    ULONG ret = funs->resolve(0, 0, (LPSTR) name, 0, 0, desc_lookup);+    if (ret == SUCCESS_SUCCESS) {+        memcpy(desc, *desc_lookup, sizeof(MapiRecipDesc));+    } else {+        /* Default to something sensible if MAPIResolveName is not supported +         * by the mail client (thunderbird)+         */+        memset(desc, 0, sizeof(MapiRecipDesc));+        desc->lpszName = (LPSTR)name;+        desc->lpszAddress = (LPSTR)name;+        desc->lpEntryID = 0;+        desc->ulEIDSize = 0;+    }+    desc->ulRecipClass = recipClass;+}+++int load_dll(const char* name, MapiFuns* funs) {+    funs->dll = 0;+    funs->dll = LoadLibrary(name);+    if(funs->dll!=NULL) {+        /* We try first loading by easy name, then by ordinal, and then by other names seen */+        funs->logon     = (LPMAPILOGON)         GetProcAddress(funs->dll, "MAPILogon");+        if(funs->logon==NULL)+            funs->logon     = (LPMAPILOGON)         GetProcAddress(funs->dll, (LPCSTR)209);++        funs->logoff    = (LPMAPILOGOFF)        GetProcAddress(funs->dll, "MAPILogOff");+        if(funs->logoff==NULL)+            funs->logoff    = (LPMAPILOGOFF)        GetProcAddress(funs->dll, (LPCSTR)210);++        funs->resolve   = (LPMAPIRESOLVENAME)   GetProcAddress(funs->dll, "MAPIResolveName");+        if(funs->resolve==NULL)+            funs->resolve   = (LPMAPIRESOLVENAME)   GetProcAddress(funs->dll, (LPCSTR)219);++        funs->free_buf  = (LPMAPIFREEBUFFER)    GetProcAddress(funs->dll, "MAPIFreeBuffer");+        if(funs->free_buf==NULL)+            funs->free_buf  = (LPMAPIFREEBUFFER)    GetProcAddress(funs->dll, (LPCSTR)16);+        if(funs->free_buf==NULL)+            funs->free_buf  = (LPMAPIFREEBUFFER)    GetProcAddress(funs->dll, "MAPIFreeBuffer@4");++        funs->sendmail  = (LPMAPISENDMAIL)      GetProcAddress(funs->dll, "MAPISendMail");+        if(funs->sendmail==NULL)+            funs->sendmail  = (LPMAPISENDMAIL)      GetProcAddress(funs->dll, (LPCSTR)211);+    }+    return +            funs->dll!=NULL+        &&  funs->logon!=NULL+        &&  funs->logoff!=NULL+        &&  funs->resolve!=NULL+        &&  funs->free_buf!=NULL+        &&  funs->sendmail!=NULL;+}+void free_dll(MapiFuns* funs) {+    if(funs->dll!=NULL) FreeLibrary(funs->dll);+    funs->dll=NULL;+}+
+ src/witnesses.hs view
@@ -0,0 +1,21 @@+import Darcs.Patch.Real+import Darcs.Patch.Properties+import Darcs.Patch.Bundle+import Darcs.Patch+import Darcs.Repository.ApplyPatches+import Darcs.Patch.Match+import Darcs.Repository.HashedRepo+import Darcs.Resolution+import Darcs.Patch.Check+import Darcs.Repository.Pristine+import Darcs.Repository.DarcsRepo+import Darcs.Repository.Internal+import Darcs.Commands.Unrevert+import Darcs.Commands.WhatsNew+import Darcs.Commands.Show+import Darcs.Commands.Unrecord+import Darcs.Commands.Dist+import Darcs.Commands.TransferMode+import Darcs.Commands.GZCRCs++main = return ()
+ tests/EXAMPLE.sh view
@@ -0,0 +1,38 @@+#!/usr/bin/env bash+## Test for issueNNNN - <SYNOPSIS: WHAT IS THE BUG?  THIS SYNOPSIS+## SHOULD BE ONE OR TWO SENTENCES.>+##+## Copyright (C) YEAR  AUTHOR+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib                  # Load some portability helpers.+rm -rf R S                      # Another script may have left a mess.+darcs init      --repo R        # Create our test repos.+darcs init      --repo S+mkdir R/d/ R/e/                 # Change the working tree.+echo 'Example content.' >R/d/f+darcs record    --repo R -lam 'Add d/f and e.'+darcs mv        --repo R d/f e/+darcs record    --repo R -am 'Move d/f to e/f.'+darcs push      --repo R S -a   # Try to push patches between repos.+darcs push      --repo S R+rm -rf R/ S/                    # Clean up after ourselves.
+ tests/check.sh view
@@ -0,0 +1,35 @@+#!/usr/bin/env bash+## Ensure that "darcs check --test" succeeds when run in a complete+## repository with a dummy test that always succeeds.+##+## Copyright (C) 2008  David Roundy+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib                           # Load some portability helpers.+rm -rf R                        # Another script may have left a mess.+darcs init      --repo R+darcs setpref   --repo R test true+darcs record    --repo R -am 'true test'+touch R/f+darcs record    --repo R -lam 'added foo'+darcs check     --repo R --test+rm -rf R                        # Clean up after ourselves.
− tests/example.sh 
@@ -1,12 +0,0 @@-#!/usr/bin/env bash--. lib-alias pwd=hspwd--rm -rf temp1 temp2-mkdir temp1-cd temp1-darcs init-cd ..--rm -rf temp1 temp2
tests/filepath.sh view
@@ -4,7 +4,7 @@  . lib -DIR=`hspwd`+DIR=`pwd`  rm -rf temp1 temp2
tests/get.sh view
@@ -10,10 +10,9 @@ darcs add t.t darcs record -am "initial add" darcs changes --context > my_context-IFS='' # annoying hack for cygwin and hspwd below-DIR=`hspwd`-abs_to_context=${DIR}/my_context+DIR=`pwd`+abs_to_context="${DIR}/my_context" cd .. rm -rf temp2-darcs get temp1 --context=${abs_to_context} temp2+darcs get temp1 --context="${abs_to_context}" temp2 rm -rf temp1 temp2
+ tests/gzcrcs.sh view
@@ -0,0 +1,39 @@+#!/usr/bin/env bash+## Test for gzcrcs command - check and repair corrupted CRCs on+## compressed files+##+## Copyright (C) 2009 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++# need to do this before loading lib as that sets -e+darcs gzcrcs --help > /dev/null+if [ $? == 2 ] ; then echo gzcrcs not supported by this darcs ; exit 0 ; fi++. ../tests/lib                  # Load some portability helpers.+rm -rf maybench-crc+gunzip -c repos/maybench-crc.tgz | tar xf -+cd maybench-crc+not darcs gzcrcs --check+darcs gzcrcs --repair+darcs gzcrcs --check+cd ..+rm -rf maybench-crc
tests/haskell_policy.sh view
@@ -23,9 +23,20 @@     rm -f "$RESULT" } -+# On 2009-02-12 Petr Rockai explained this on darcs-users:+# The problem with Prelude readFile is that it's based on hGetContents, which+# is lazy by definition. This also means that unless you force consumption of+# the produced list, it will keep an fd open for the file, possibly+# indefinitely.  This is called a fd leak. Other than being annoying and if done+# often, leading to fd exhaustion and failure to open any new files (which is+# usually fatal), it also prevents the file to be unlinked (deleted) on win32.+#+# On the other hand, *strict* bytestring version of readFile will read the whole+# file into a contiguous buffer, *close the fd* and return. This is perfectly+# safe with regards to fd leaks. Btw., this is *not* the case with lazy+# bytestring variant of readFile, so that one is unsafe. lookfor readFile \-        "readFile doesn't ensure the file is closed before it is deleted!" \+        "Prelude.readFile doesn't ensure the file is closed before it is deleted!\nConsider import Data.ByteString.Char8 as B (readFile), B.readFile instead." \         B # importing readFile from Data.ByteString as B, is allowed  lookfor hGetContents \
+ tests/hspwd.hs view
@@ -0,0 +1,5 @@+module Main where++import Directory ( getCurrentDirectory )++main = getCurrentDirectory >>= putStr
tests/issue1057.sh view
@@ -1,7 +1,28 @@ #!/usr/bin/env bash--# http://bugs.darcs.net/issue1057: Identifying current repository when pulling from repository identified via symbolic link-+## Test for issue1057 - when pulling from a symlink to the current+## repository, Darcs should detect that it *is* the current repo.+##+## Copyright (C) 2008  Thorkil Naur+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.  . lib @@ -16,7 +37,7 @@  ln -s repo srepo cd srepo-DIR=`hspwd`+DIR=`pwd` echo $DIR not darcs pull --debug -a "$DIR" 2> out cat out
tests/issue1078_symlink.sh view
@@ -14,9 +14,8 @@ cd temp2 darcs init touch a b-IFS='' # annoying hack for cygwin and hspwd below-DIR=`hspwd`-darcs add ${DIR}/../temp1/a # should work, just to contrast with the case below-darcs add ${DIR}/b          # this is the case we are testing for+DIR=`pwd`+darcs add "${DIR}/../temp1/a" # should work, just to contrast with the case below+darcs add "${DIR}/b"          # this is the case we are testing for cd .. rm -rf temp1 temp2
+ tests/issue1162_add_nonexistent_slash.sh view
@@ -0,0 +1,16 @@+#!/bin/sh++set -ev++not () { "$@" && exit 1 || :; }++rm -rf temp+mkdir temp+cd temp+darcs init+not darcs add a/ 2> err+cat err+grep 'does not exist (No such file or directory)' err+cd ..++rm -rf temp
+ tests/issue1248.sh view
@@ -0,0 +1,21 @@+#!/usr/bin/env bash+## Test for issue1248 - darcs doesn't handle darcs 1 repos with compressed+## inventories+##+## Placed into the public domain by Ganesh Sittampalam, 2009++. lib+rm -rf temp1+mkdir temp1+cd temp1+darcs init --old-fashioned+touch foo+darcs rec -a -m'foo' -l --author=me@me+darcs tag --author=me@me foo+darcs check+darcs optimize --reorder+darcs check+darcs optimize --compress+darcs check+cd ..+rm -rf temp1
+ tests/issue1269_setpref_predist.sh view
@@ -0,0 +1,28 @@+#!/bin/sh++set -ev++not () { "$@" && exit 1 || :; }++rm -rf temp+rm -rf dist1269.tar.gz+mkdir temp+cd temp++darcs init+printf "Line1\nLine2\nLine3\n" > foo+darcs record -alm Base++darcs setpref predist false++# It is a bug in darcs if the dist succeeds. It should+# fail with a non-zero exit code+not darcs dist -d dist1269++# It is a bug in darcs if the dist file has been created+# it should /not/ be created if the predist cmd returned+# a non-zero exit code+not test -f dist1269.tar.gz++cd ..+rm -rf temp
+ tests/issue1373_replace_token_chars.sh view
@@ -0,0 +1,49 @@+#!/usr/bin/env bash+## Test for issue1373 - check that --token-chars [^ \t] is allowed.+## While we're at it, check some other things *aren't* allowed.+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib++rm -rf temp                     # Another script may have left a mess.+darcs init --repodir temp+replace () { darcs replace --repodir temp --token-chars "$1" x y; }+## These are not well-formed tokens.+not replace ''+not replace 'a'+not replace ']a['+not replace '[]'+not replace '[^]'+## These are well-formed, but allow tokens to contain whitespace.+not replace $'[ ]'+not replace $'[\t]'+not replace $'[\n]'+not replace $'[\r]'+not replace $'[\v]'+not replace $'[^ ]'+not replace $'[^\t]'+not replace $'[^\n]'+not replace $'[^\r]'+not replace $'[^\v]'+rm -rf temp                     # Clean up after ourselves.
+ tests/issue1446.sh view
@@ -0,0 +1,53 @@+#!/usr/bin/env bash+## Test for issue1446 - darcs amend-record -m foo destroys long description without warning+##+## Copyright (C) 2009  Dmitry Kurochkin+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib                           # Load some portability helpers.+rm -rf R                        # Another script may have left a mess.+darcs init      --repo R        # Create our test repo.++touch R/f+darcs add f     --repo R+echo 'patch name' > R/patchinfo+echo 'patch description' >> R/patchinfo+darcs record -a --logfile=R/patchinfo --repo R+darcs changes   --repo R | grep 'patch name'+darcs changes   --repo R | grep 'patch description'++echo 'y' | darcs amend-record -p 'patch name' -m 'new name' --repo R+darcs changes   --repo R | grep 'new name'+darcs changes   --repo R | grep 'patch description'++echo content > R/f+echo 'another name' > R/patchinfo+echo 'another description' >> R/patchinfo+darcs record -a --logfile=R/patchinfo --repo R+darcs changes   --repo R | grep 'another name'+darcs changes   --repo R | grep 'another description'++echo 'y' | darcs amend-record -p 'another name' -m 'one more name' --repo R+darcs changes   --repo R | grep 'one more name'+darcs changes   --repo R | grep 'another description'++rm -rf R/                       # Clean up after ourselves.
+ tests/issue1465_ortryrunning.sh view
@@ -0,0 +1,42 @@+#!/usr/bin/env bash+## Test for issue1465 - ortryrunning should try RHS if AND ONLY IF the+## LHS actually failed wasn't found or wasn't executable.+##+## Copyright (C) 2009  Trent W. Buck+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. ../tests/lib                  # Load some portability helpers.+rm -rf R                        # Another script may have left a mess.+darcs init      --repo R        # Create our test repo.+mkdir R/d                       # Change the working tree.++# Set the editor to a program that just fails (VISUAL), make Darcs use+# it (--edit), and then make sure when it brokenly launches a fallback+# editor, that editor will exit because stdin isn't a tty (/dev/null).+not env -u TERM VISUAL=false </dev/null &>R/log \+darcs record    --repo R -lam 'Initial commit.' --edit++# If Darcs did the right thing, the output won't make any mention of+# the fallback editors.+not egrep -i 'not found|vi|emacs|nano|edit' R/log++rm -rf R/                       # Clean up after ourselves.
tests/issue154_pull_dir_not_empty.sh view
@@ -1,7 +1,28 @@ #!/usr/bin/env bash--# A test for pulling a patch to remove a directory when the local copy is not empty.-# Issue154+## Test for issue154 - when applying a patch that removes a directory,+## don't remove the directory from the working tree unless it's empty.+##+## Copyright (C) 2008  Mark Stosberg+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.  . lib
tests/issue595_get_permissions.sh view
@@ -23,10 +23,7 @@ darcs 'init' cd .. -# this is an ugly hack for Cygwin and pwd-IFS=''-DIR=`hspwd`-+DIR=`pwd` # Set up a directory with restrictive permissions mkdir -p tmp_restrictive/liberal cd tmp_restrictive/liberal@@ -38,7 +35,7 @@ touch can_touch if [ -e can_touch ]; then   if hwpwd; then-    darcs get $DIR/tmp_remote 2> log+    darcs get "$DIR/tmp_remote" 2> log     not grep -i 'permission denied' log   else     echo "Apparently I can't do `basename $0` on this platform"@@ -46,7 +43,7 @@ else   echo "Can't do `basename $0` on this platform" fi-cd $DIR+cd "$DIR" # We have to fix the permissions, just so we can delete it. chmod 0755 tmp_restrictive
tests/issue70_setpref.sh view
@@ -1,8 +1,31 @@ #!/usr/bin/env bash+## Test for issue70 - unrecorded (pending) changes to preferences+## should coalesce; if you set the same preference more than once in+## the same patch, only the last change should actually be recorded.+##+## Copyright (C) 2005  Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.  . lib--# issue70 and RT #349 - setpref should coalesce changes  rm -rf temp1 mkdir temp1
tests/lib view
@@ -11,3 +11,8 @@   exit 0 fi }++pwd() {+    ghc --make "$TESTS_WD/hspwd.hs"+    "$TESTS_WD/hspwd"+}
tests/mv-formerly-pl.sh view
@@ -117,8 +117,7 @@  touch abs_path.t darcs add abs_path.t-IFS=""-REPO_ABS=`hspwd`+REPO_ABS=`pwd` darcs mv "$REPO_ABS/abs_path.t" abs_path_new.t darcs mv abs_path_new.t "$REPO_ABS/abs_path.t"
− tests/network/bug.sh 
@@ -1,17 +0,0 @@-#!/bin/env bash--set -ev--## The builtin ! has the wrong semantics for not.-not () { "$@" && exit 1 || :; }--rm -rf temp-mkdir temp-cd temp--not darcs show bug &> bugout-cat bugout-grep 'lease report this' bugout--cd ..-rm -rf temp
tests/network/changes.sh view
@@ -2,7 +2,4 @@ set -ev  # Demonstrates issue385--test "$DARCS" || DARCS="$PWD"/../darcs--"$DARCS" changes --repo=http://darcs.net GNUmakefile --last 300+darcs changes --repo=http://darcs.net GNUmakefile --last 300
tests/pull.sh view
@@ -53,8 +53,7 @@ not grep temp1 _darcs/prefs/defaultrepo  #return special message when you try to pull from yourself-IFS=""-DIR=`hspwd`+DIR="`pwd`" not darcs pull --debug -a "$DIR" 2> out cat out grep 'Can.t pull from current repository' out
tests/pull_binary.sh view
@@ -10,7 +10,7 @@ mkdir temp1 cd temp1 darcs init-perl -e 'print "a"x1048576' > foo+printf "%01048576d" 0 > foo darcs record -l -a -A author -m xx rm foo darcs record -a -A author -m yy
tests/pull_compl.sh view
@@ -26,7 +26,8 @@  chgrec () {     set -ev-    perl -i~ -pe "$1" foo+    sed -e "$1" foo > foo.tmp+    mv foo.tmp foo     darcs record -a --ignore-times -m "$2" }
tests/push-formerly-pl.sh view
@@ -4,10 +4,7 @@  . lib -# setting IFS is an ugly hack for Cygwin-# so that the hspwd backtick-IFS=''-DIR=`hspwd`+DIR="`pwd`"  rm -rf temp1 temp2 mkdir temp1@@ -43,8 +40,8 @@ # Before trying to pull from self, defaultrepo does not exist test ! -e _darcs/prefs/defaultrepo # return special message when you try to push to yourself-not darcs push -a ${DIR}/temp1 2> log-grep -i "can't push to current repository!" log+not darcs push -a "$DIR/temp1" 2> log+grep -i "cannot push from repository to itself" log # and don't update the default repo to be the current dir test ! -e _darcs/prefs/defaultrepo cd ..
tests/put.sh view
@@ -21,11 +21,9 @@ # put to self cd temp1 not grep temp1 _darcs/prefs/defaultrepo-# hack for cygwin and hspwd below-IFS=''-DIR=`hspwd`+DIR=`pwd` # return special message when you try to put put yourself-not darcs put ${DIR} 2> log+not darcs put "$DIR" 2> log not grep temp1 _darcs/prefs/defaultrepo grep -i "Can't put.*current repository" log cd ..
tests/record.sh view
@@ -31,13 +31,10 @@ darcs record  -am foo a.t b.t > log grep -i 'non existent files or directories: "a.t"' log -# record works with absolute paths-# hack for Cygwin and hspwd-IFS=''-DIR=`hspwd`+DIR="`pwd`" touch date.t darcs add date.t-darcs record -a -m foo ${DIR}/date.t | grep -i 'finished recording'+darcs record -a -m foo "$DIR/date.t" | grep -i 'finished recording'  # issue396 - record -l "" touch 'notnull.t'
tests/record_editor.sh view
@@ -15,7 +15,7 @@ darcs init touch file.t darcs add file.t-darcs record --edit-long-comment -a -m foo file.t | grep '2.*END OF DESCRIPTION'+echo y | darcs record --edit-long-comment -a -m foo file.t | grep '2.*END OF DESCRIPTION' cd .. rm -rf temp1 @@ -25,7 +25,7 @@ darcs init touch file.t darcs add file.t-darcs record --edit-long-comment -a -m foo file.t | grep '2.*END OF DESCRIPTION'+echo y | darcs record --edit-long-comment -a -m foo file.t | grep '2.*END OF DESCRIPTION' cd .. rm -rf temp2\ dir @@ -36,7 +36,7 @@ darcs init touch file.t darcs add file.t-darcs record --edit-long-comment -a -m foo file.t | grep 'END OF'+echo y | darcs record --edit-long-comment -a -m foo file.t | grep 'END OF' cd .. rm -rf temp1 @@ -53,7 +53,7 @@ echo EVIL FOO chmod u+x test-command-darcs record --logfile='; test-command' --edit-long-comment -a -m foo file.t > log+echo y | darcs record --logfile='; test-command' --edit-long-comment -a -m foo file.t > log not grep EVIL log cd .. rm -rf temp1
tests/replace.sh view
@@ -8,10 +8,15 @@ darcs init  echo "X X X" > foo+echo $'A A,A\tA,A\vA' >> foo darcs rec -alm "Added" -# This should fail until replace handles spaces+# These should fail until replace handles tokens and+# token-chars with leteral spaces in them darcs replace ' X ' ' XX ' --token-chars '[ X]' foo && exit 1 || true+darcs replace $'A A'  'aaa' --token-chars '[^,]' foo && exit 1 || true+darcs replace $'A\tA' 'aaa' --token-chars '[^,]' foo && exit 1 || true+darcs replace $'A\vA' 'aaa' --token-chars '[^,]' foo && exit 1 || true  # Check that replace is not fooled by duplicate file names # (i.e. not trying to performe the replace twice in the same file)
tests/repodir.sh view
@@ -18,11 +18,11 @@  echo > _darcs/prefs/defaults ALL disable # try to disable all not darcs changes-not darcs changes --repodir "$PWD"+not darcs changes --repodir "`pwd`"  cd ..  not darcs changes --repodir repo-not darcs changes --repodir "$PWD/repo"+not darcs changes --repodir "`pwd`/repo"  rm -rf temp
+ tests/repos/maybench-crc.tgz view

binary file changed (absent → 114197 bytes)

tests/send_apply.sh view
@@ -26,6 +26,9 @@ mkdir temp2 cd temp2 darcs init+darcs apply ../temp1/funpatch+## Also test that "darcs apply" can accept a patch on stdin.+darcs obl -a darcs apply < ../temp1/funpatch cd .. cmp temp1/bar temp2/bar
tests/toolbox.sh view
@@ -2,7 +2,7 @@  . lib -DIR=`hspwd`+DIR="`pwd`"  abort_windows
tests/whatsnew.sh view
@@ -26,19 +26,27 @@   echo  test does not work on windows   exit 0; else-  touch \\+  echo foo > \\   darcs add \\-  darcs whatsnew > log-  not grep "no changes" log+  darcs whatsnew | tee log+  grep 'hunk ./\\92\\' log fi +echo foo > "foo bar"+darcs add "foo bar"+darcs wh | tee log+grep 'hunk ./foo\\32\\bar' log++# check that filename encoding does not botch up the index+darcs rec -am "weird filenames"+not darcs wh+ # whatsnew works with absolute paths-IFS='' # annoying hack for cygwin and hspwd below-DIR=`hspwd`+DIR="`pwd`" echo date.t > date.t touch date.t darcs add date.t-darcs whatsnew ${DIR}/date.t | grep hunk+darcs whatsnew "$DIR/date.t" | grep hunk  cd ..
− tools/cgi/README.in 
@@ -1,42 +0,0 @@-darcs.cgi is the darcs repository viewer.  It provides a web interface-for viewing darcs repositories, using XSLT to transform darcs' XML-output into XHTML. It is written in perl and is more featureful than-the older haskell cgi program darcs_cgi.lhs (seen in URLs as "darcs").--dependencies--  darcs.cgi requires with the following tools and has been tested with-  the version mentioned:--  darcs-1.0.1           http://www.darcs.net-  libxslt-1.1.6         http://xmlsoft.org/XSLT/-  perl-5.8.0            http://www.perl.com--installation--  1) copy darcs.cgi to your webserver's cgi directory, eg-     /usr/lib/cgi-bin. A symlink probably won't do. Make-     sure it's executable.-  2) copy cgi.conf to @sysconfdir@/darcs/cgi.conf and edit appropriately.-     You can overwrite the cgi.conf used by the old darcs cgi script.-     You probably don't need to change anything here.-  3) copy the xslt directory to @datadir@/darcs/xslt-  4) copy xslt/styles.css to @sysconfdir@/darcs/styles.css--  Test by browsing "http://<host>/cgi-bin/darcs.cgi/".--troubleshooting--  if the configuration is incorrect error messages will be printed to-  the webserver's error log, for example "/var/log/apache/error.log".--  you can also double check the configuration by running darcs.cgi-  from the command line and supplying a --check argument:--     $ ./darcs.cgi --check--character encodings--  if your repositories contain files with characters encoded in-  something other than ASCII or UTF-8, change the 'xml_encoding'-  setting in cgi.conf to the appropriate encoding.
− tools/cgi/cgi.conf.in 
@@ -1,31 +0,0 @@-# This is an example for cgi.conf--# reposdir is the directory containing the repositories--reposdir = /var/www/repos--# cachedir is a directory writable by www-data (or whatever user your cgi-# scripts run as) which is used to cache the web pages.--cachedir = /var/cache/darcs--# The following are used by darcs.cgi (not darcs_cgi)-PATH = /bin:/usr/bin:/usr/local/bin--# paths to executables, or just the executables if they are in 'PATH'-#darcs = darcs-#xsltproc = xsltproc--# Path to XSLT templates (default is /usr/local/share/darcs/xslt)-xslt_dir = @datadir@/darcs/xslt--# HTTP request path of the style sheet, the default will magically read -# @sysconfdir@/darcs/styles.css-#stylesheet = /cgi-bin/darcs.cgi/styles.css--css_styles  = @sysconfdir@/darcs/styles.css--# encoding to include in XML declaration.  Set this to the encoding used-# by the files in your repositories.--xml_encoding = UTF-8
− tools/cgi/darcs.cgi.in 
@@ -1,491 +0,0 @@-#!/usr/bin/perl -T-#-# darcs.cgi - the darcs repository viewer-#-# Copyright (c) 2004 Will Glozer-#-# Permission is hereby granted, free of charge, to any person obtaining-# a copy of this software and associated documentation files (the-# "Software"), to deal in the Software without restriction, including-# without limitation the rights to use, copy, modify, merge, publish,-# distribute, sublicense, and/or sell copies of the Software, and to-# permit persons to whom the Software is furnished to do so, subject to-# the following conditions-#-# The above copyright notice and this permission notice shall be-# included in all copies or substantial portions of the Software.-#-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE-# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION-# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION-# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.--#-# This program calls darcs (or its own subroutines) to generate XML-# which is rendered into HTML by XSLT.  It is capable of displaying-# the files in a repository, various patch histories, annotations, etc.-#--use strict;--use CGI qw( :standard );-use CGI::Util;-use File::Basename;-use File::stat;-use IO::File;-use POSIX;--## the following variables can be customized to reflect your system-## configuration by defining them appropriately in the file-## "@sysconfdir@/darcs/cgi.conf".  The syntax accepts equals signs or simply-## blanks separating values from assignments.--$ENV{'PATH'} = read_conf('PATH', $ENV{'PATH'});--# path to executables, or just the executable if they are in $ENV{'PATH'}-my $darcs_program    = read_conf("darcs", "darcs");-my $xslt_program     = read_conf("xsltproc", "xsltproc");--# directory containing repositories-my $repository_root  = read_conf("reposdir", "/var/www");--# XSLT template locations-my $template_root = read_conf("xslt_dir", '@datadir@/darcs/xslt');--my $xslt_annotate = "$template_root/annotate.xslt";-my $xslt_browse   = "$template_root/browse.xslt";-my $xslt_patches  = "$template_root/patches.xslt";-my $xslt_repos    = "$template_root/repos.xslt";-my $xslt_rss      = "$template_root/rss.xslt";--my $xslt_errors   = "$template_root/errors.xslt";--# CSS stylesheet that XSLT templates refer to.  This is a HTTP request-# path, not a local file system path. The default will cause darcs.cgi-# to serve the stylesheet rather than the web server.-my $stylesheet = read_conf("stylesheet", "/cgi-bin/darcs.cgi/styles.css");--# location of the CSS stylesheet that darcs.cgi will serve if it-# receives a request for '/styles.css'-my $css_styles = read_conf("css_styles", '@sysconfdir@/darcs/styles.css');--# location of the favicon that darcs.cgi will serve if it-# receives a request for '/[\w\-]+/favicon.ico'-my $favicon = read_conf("favicon", "/cgi-bin/favicon.ico");--# XML source for the error pages-my $xml_errors = "$template_root/errors.xml";--# encoding to include in XML declaration-my $xml_encoding = read_conf("xml_encoding", "UTF-8");--## end customization--# ------------------------------------------------------------------------# read a value from the cgi.conf file.-{-  my(%conf);--  sub read_conf {-    my ($flag, $val) = @_;-    $val = "" if !defined($val);-    -    if (!%conf && open(CGI_CONF, '@sysconfdir@/darcs/cgi.conf')) {-      while (<CGI_CONF>) {-        chomp;-	next if /^\s*(?:\#.*)?$/;   # Skip blank lines and comment lines-        if (/^\s*(\S+)\s*(?:\=\s*)?(\S+)\s*$/) {-           $conf{$1} = $2;-	   # print "read_conf: $1 = $2\n";-        } else {-           warn "read_conf: $_\n";-        }-      }-      close(CGI_CONF);-    }--    $val = $conf{$flag} if exists($conf{$flag});--    return $val;-  }-}--# open xsltproc to transform and output `xml' with stylesheet file `xslt'-sub transform {-    my ($xslt, $args, $content_type) = @_;--    $| = 1;-    printf "Content-type: %s\r\n\r\n", $content_type || "text/html";-    my $pipe = new IO::File "| $xslt_program $args $xslt -";-    $pipe->autoflush(0);-    return $pipe;-}--sub pristine_dir {-    my ($repo) = @_;-    my $pristine = "current";-    if (! -d "${repository_root}/${repo}/_darcs/$pristine") {-        $pristine = "pristine";-    }-    return "${repository_root}/${repo}/_darcs/$pristine";-}--# begin an XML document with a root element and the repository path-sub make_xml {-    my ($fh, $repo, $dir, $file) = @_;-    my ($full_path, $path) = '/';--    printf $fh qq(<?xml version="1.0" encoding="$xml_encoding"?>\n);--    printf $fh qq(<darcs repository="$repo" target="%s/%s%s">\n),-        $repo, ($dir ? "$dir/" : ''), ($file ? "$file" : '');--    print $fh qq(<path>\n);-    foreach $path (split('/', "$repo/$dir")) {-        $full_path .= "$path/";-        print $fh qq(<directory full-path="$full_path">$path</directory>\n);-    }-    if ($file) {-        print $fh qq(<file full-path="$full_path$file">$file</file>\n) if $file;-    }-    print $fh qq(</path>\n\n);-}--# finish XML output-sub finish_xml {-    my ($fh) = @_;-    print $fh "\n</darcs>\n";-    $fh->flush;-}--# run darcs and wrap the output in an XML document-sub darcs_xml {-    my ($fh, $repo, $cmd, $args, $dir, $file) = @_;--    make_xml($fh, $repo, $dir, $file);--    push(@$args, '--xml-output');-    darcs($fh, $repo, $cmd, $args, $dir, $file);--    finish_xml($fh);-}--# run darcs with output redirected to the specified file handle-sub darcs {-    my ($fh, $repo, $cmd, $args, $dir, $file) = @_;-    my (@darcs_argv) = ($darcs_program, $cmd, @$args);--    # push target only if there is one, otherwise darcs will get an empty param-    if ($dir || $file) {-        push(@darcs_argv, sprintf("%s%s%s", $dir, ($dir ? '/' : ''), $file));-    }--    my($pid) = fork;-    if ($pid) {-	# in the parent process-	my($status) = waitpid($pid, 0);-	die "$darcs_program exited with status $?\n" if $?;-    } elsif(defined($pid)) {-	# in the child process-	open(STDIN, '/dev/null');-	if (defined($fh)) {-	    open(STDOUT, '>&', $fh)-		|| die "can't dup to stdout: $!\n";-	}-	chdir "$repository_root/$repo"-	    || die "chdir: $repository_root/$repo: $!\n";-	exec @darcs_argv;-	die "can't exec ".$darcs_argv[0].": $!\n";-    } else {-	# fork failed-	die "can't fork: $!\n";-    }-}--# get a directory listing as XML output-sub dir_listing {-    my ($fh, $repo, $dir) = @_;-    make_xml($fh, $repo, $dir, '');--    print $fh "<files>\n";-    my $dir_ = pristine_dir ($repo) . "/$dir";-    opendir(DH, $dir_);-    while( defined (my $file_ = readdir(DH)) ) {-        next if $file_ =~ /^\.\.?$/;-        my $file = "$dir_/$file_";-        my $secs  = stat($file)->mtime;-        my $mtime = localtime($secs);-        my $ts = POSIX::strftime("%Y%m%d%H%M%S", gmtime $secs);--        my ($name, $type);--         if (-d $file) {-             ($name, $type) = (basename($file) . '/', 'directory');-         } else {-             ($name, $type) = (basename($file), 'file');-         }-         print $fh qq(  <$type name="$name" modified="$mtime" ts="$ts" />\n);-    }-    closedir(DH);-    print $fh "</files>\n";--    finish_xml($fh);-}--# get a repository listing as XML output-sub repo_listing {-    my($fh) = @_;--    make_xml($fh, "", "", "");--    print $fh "<repositories>\n";-    opendir(DH, $repository_root);-    while( defined (my $name = readdir(DH)) ) {-        next if $name =~ /^\.\.?$/;-        if (-d "$repository_root/$name/_darcs") {-            print $fh qq(  <repository name="$name" />\n);-        }-    }-    closedir(DH);-    print $fh "</repositories>\n";--    finish_xml($fh);-    return $fh;-}--# show an error page-sub show_error {-    my ($type, $code, $message) = @_;-    my $xml;--    # set the xslt processing arguments-    my $xslt_args = qq {-        --stringparam error-type '$type'-        --stringparam stylesheet '$stylesheet'-    };-    $xslt_args =~ s/\s+/ /gm;--    print "Status: $code $message\r\n\r\n";-    system("$xslt_program $xslt_args $xslt_errors $xml_errors");-}--# check if the requested resource has been modified since the client last-# saw it. If not send HTTP status code 304, otherwise set the Last-modified-# and Cache-control headers.-sub is_cached {-    my ($path) = @_;-    my ($stat) = stat($path);--    # stat may fail because the path was renamed or deleted but still referred-    # to by older darcs patches-    if ($stat) {-        my $last_modified = CGI::expires($stat->mtime);--        if (http('If-Modified-Since') eq $last_modified) {-            print("Status: 304 Not Modified\r\n\r\n");-            return 1;-        }--        print("Cache-control: max-age=0, must-revalidate\r\n");-        print("Last-modified: $last_modified\r\n");-    }-    return 0;-}--# safely extract a parameter from the http request.  This applies a regexp-# to the parameter which should group only the appropriate parameter value-sub safe_param {-    my ($param, $regex, $default) = @_;-    my $value = CGI::Util::unescape(param($param));-    return ($value =~ $regex) ? $1 : $default;-}--# common regular expressions for validating passed parameters-my $hash_regex = qr/^([\w\-.]+)$/;-my $path_regex = qr@^([^\\!\$\^&*()\[\]{}<>`|';"?\r\n]+)$@;--# respond to a CGI request-sub respond {-    # untaint the full URL to this CGI-    my $cgi_url = CGI::Util::unescape(url());-    $cgi_url =~ $path_regex or die qq(bad url "$cgi_url");-    $cgi_url = $1;--    # untaint script_name, reasonable to expect only \w, -, /, and . in the name-    my $script_name = CGI::Util::unescape(script_name());-    $script_name =~ qr~^([\w/.\-\~]+)$~ or die qq(bad script_name "$script_name");-    $script_name = $1;--    # untaint simple parameters, which can only have chars matching \w+-    my $cmd  = safe_param('c', '^(\w+)$', 'browse');-    my $sort = safe_param('s', '^(\w+)$', '');--    # set the xslt processing arguments-    my $xslt_args = qq {-        --stringparam cgi-program '$script_name'-        --stringparam cgi-url '$cgi_url'-        --stringparam sort-by '$sort'-        --stringparam stylesheet '$stylesheet'-    };-    $xslt_args =~ s/\s+/ /gm;--    my ($path) = CGI::Util::unescape(path_info());-    # don't allow ./ or ../ in paths-    $path =~ s|[.]+/||g;--    # check whether we're asking for styles.css-    if ($path eq '/styles.css') {-        return if is_cached($css_styles);--        open (STYLES_CSS, $css_styles) or die qq(couldn't open "${css_styles}");-        my $size = stat($css_styles)->size;--        print "Content-length: $size\r\n";-        print "Content-type: text/css\r\n\r\n";--        while (<STYLES_CSS>) {-          print $_;-        }-        close (STYLES_CSS);-        return;-    }--    # check whether we're asking for favicon.ico-    if ($path =~ '/[\w\-]+/favicon.ico') {-        return if is_cached($favicon);--        open (FAVICON, $favicon) or die qq(couldn't open "${favicon}");-        my $size = stat($favicon)->size;--        print "Content-length: $size\r\n";-        print "Content-type: image/x-icon\r\n\r\n";--        while (<FAVICON>) {-          print $_;-        }-        close (FAVICON);-        return;-    }--    # when no repository is requested display available repositories-    if (length($path) < 2) {-        my $fh = transform($xslt_repos, $xslt_args);-        repo_listing($fh);-        return;-    }--    # don't allow any shell meta characters in paths-    $path =~ $path_regex or die qq(bad path_info "$path");-    my @path = split('/', substr($1, 1));--    # split the path into a repository, directory, and file-    my ($repo, $dir, $file, @bits) = ('', '', '');-    while (@path > 0) {-        $repo = join('/', @path);-        # check if remaining path elements refer to a repo-        if (-d "${repository_root}/${repo}/_darcs") {-            if (@bits > 1) {-                $dir  = join('/', @bits[0..$#bits - 1]);-            }-            $file = $bits[$#bits];-            # check if last element of path, stored in $file, is really a dir-            if (-d (pristine_dir ($repo) . "/${dir}/${file}")) {-                $dir = ($dir ? "$dir/$file" : $file);-                $file = '';-            }-            last;-        } else {-            $repo = '';-            unshift(@bits, pop @path);-        }-    }--    # make sure the repository exists-    unless ($repo) {-        show_error('invalid-repository', '404', 'Invalid repository');-        return;-    }--    # don't generate output unless the requested path has been-    # modified since the client last saw it.-    return if is_cached(pristine_dir ($repo) . "/$dir/$file");--    # untaint patches and tags. Tags can have arbitrary values, so-    # never pass these unquoted, on pain of pain!-    my $patch = safe_param('p', $hash_regex);-    my $tag   = safe_param('t', '^(.+)$');--    my @darcs_args;-    push(@darcs_args, '--match', "hash $patch") if $patch;-    push(@darcs_args, '-t', $tag) if $tag;--    # process the requested command-    if ($cmd eq 'browse') {-        my $fh = transform($xslt_browse, $xslt_args);-        dir_listing($fh, $repo, $dir);-    } elsif ($cmd eq 'patches') {-        # patches as an option is used to support "--patches"-        if (my $patches = safe_param('patches','^(.+)$')) {-            push @darcs_args, '--patches', $patches;-        }--        my $fh = transform($xslt_patches, $xslt_args);-        darcs_xml($fh, $repo, "changes", \@darcs_args, $dir, $file);-    } elsif ($cmd eq 'annotate') {-        push(@darcs_args, '--summary');--        my $creator_hash  = safe_param('ch', $hash_regex);-        my $original_path = safe_param('o', $path_regex);-        my $fh = transform($xslt_annotate, $xslt_args);--        # use the creator hash and original file name when available so-        # annotations can span renames-        if ($creator_hash ne '' && $original_path ne '') {-            push(@darcs_args, '--creator-hash', $creator_hash);-            darcs_xml($fh, $repo, "annotate", \@darcs_args, '', $original_path);-        } else {-            darcs_xml($fh, $repo, "annotate", \@darcs_args, $dir, $file);-        }-    } elsif ($cmd eq 'diff') {-        push(@darcs_args, '-u');-        print "Content-type: text/plain\r\n\r\n";-        darcs(undef, $repo, "diff", \@darcs_args, $dir, $file);-    } elsif ($cmd eq 'rss') {-        push(@darcs_args, '--last', '25');--        my $fh = transform($xslt_rss, $xslt_args, "application/rss+xml");-        darcs_xml($fh, $repo, "changes", \@darcs_args, $dir, $file);-    } else {-        show_error('invalid-command', '400', 'Invalid command');-    }-}--# run a self-test when the --check argument is supplied-if ($ARGV[0] eq '--check') {-    (read_conf("css_styles", "abc") ne "abc") ||-        die "cannot read config file: $!\n";--    (`$darcs_program`) ||-        die "cannot execute darcs as '$darcs_program': $!\n";-    (`$xslt_program`) ||-        die "cannot execute xstlproc as '$xslt_program': $!\n";--    (-d $repository_root && -r $repository_root) ||-        die "cannot read repository root directory '$repository_root': $!\n";-    (-d $template_root && -r $template_root) ||-        die "cannot read template root directory '$template_root': $!\n";-    (-f $css_styles) ||-        die "cannot read css stylesheet '$css_styles': $!\n";-    (-f $xml_errors) ||-        die "cannot read error messages '$xml_errors': $!\n";--    exit 0;-}--# handle the CGI request-respond();-
− tools/cgi/xslt/annotate.xslt 
@@ -1,390 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>--<!--- template for converting darcs' `annotate` output from XML to XHTML.  This- template expects the following external variables:--   cgi-program    - path to the CGI executable, to place in links-   sort-by        - field to sort by-   stylesheet     - path to the CSS stylesheet---->-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">-  <xsl:strip-space elements="*"/>--  <xsl:include href="common.xslt"/>--  <xsl:template match="path">-    <h1 class="target">-        annotations for <span class="path"><a href="{$cgi-program}">projects</a></span> / <span class="path"><xsl:apply-templates/></span>-    </h1>-  </xsl:template>--  <!-- patch annotate tags -->-  <xsl:template match="/darcs/patch">-    <xsl:call-template name="show-patch-info">-      <xsl:with-param name="patch" select="."/>-      <xsl:with-param name="show-comment" select="true()"/>-      <xsl:with-param name="show-author" select="true()"/>-      <xsl:with-param name="show-date" select="true()"/>-    </xsl:call-template>-  </xsl:template>-  -  <xsl:template match="summary">-    <xsl:variable name="hash" select="../patch/@hash"/>-      -    <table>-      <tr class="annotate">-        <th>file</th>-        <th>change</th>-        <th></th>-        <th></th>-      </tr>--      <xsl:apply-templates/>-    </table>--    <form action="{$command}" method="get">-      <p>-        <input type="submit" name="c" value="diff"/>-        <input type="hidden" name="p" value="{$hash}"/>-      </p>-    </form>-  </xsl:template>-  -  <xsl:template match="modify_file">-    <xsl:variable name="file" select="text()"/>-    <xsl:variable name="hash" select="/darcs/patch/@hash" />-      -    <tr class="modified-file">-      <td><xsl:value-of select="$file"/></td>--      <td class="line-count">-        <xsl:for-each select="added_lines">-          +<xsl:value-of select="@num"/>/-        </xsl:for-each>-        <xsl:for-each select="removed_lines">-<xsl:value-of select="@num"/>-        </xsl:for-each>-        lines-      </td>--      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$file}?c=patches">patches</a></td>-    </tr>-  </xsl:template>--  <xsl:template match="add_file">-    <xsl:variable name="file" select="text()"/>-    <xsl:variable name="hash" select="/darcs/patch/@hash" />-    -    <tr class="add-remove-file">-      <td><xsl:value-of select="$file"/></td>-      <td>added file</td>-      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$file}?c=patches">patches</a></td>-    </tr>-  </xsl:template>--  <xsl:template match="move">-    <xsl:variable name="file" select="@to"/>-    <xsl:variable name="old-file" select="@from"/>    -    <xsl:variable name="hash" select="/darcs/patch/@hash" />-    -    <tr class="add-remove-file">-      <td><xsl:value-of select="$file"/></td>-      <td>moved from <xsl:value-of select="$old-file"/></td>-      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$file}?c=patches">patches</a></td>-    </tr>-  </xsl:template>--  <xsl:template match="remove_file">-    <xsl:variable name="file" select="text()"/>-    <xsl:variable name="hash" select="/darcs/patch/@hash" />-    -    <tr class="add-remove-file">-      <td><xsl:value-of select="$file"/></td>-      <td>removed file</td>-      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$file}?c=patches">patches</a></td>-    </tr>-  </xsl:template>--  <xsl:template match="add_directory">-    <xsl:variable name="dir" select="text()"/>-    <xsl:variable name="hash" select="/darcs/patch/@hash" />-    -    <tr class="add-remove-file">-      <td><xsl:value-of select="$dir"/></td>-      <td>added directory</td>-      <td><a href="{$command}{$dir}/?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$dir}/?c=patches">patches</a></td>-    </tr>-  </xsl:template>--  <xsl:template match="remove_directory">-    <xsl:variable name="dir" select="text()"/>-    <xsl:variable name="hash" select="/darcs/patch/@hash" />-    -    <tr class="add-remove-file">-      <td><xsl:value-of select="$dir"/></td>-      <td>removed directory</td>-      <td><a href="{$command}{$dir}/?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$dir}/?c=patches">patches</a></td>-    </tr>-  </xsl:template>-  -  <!-- directory annotate templates -->-  <xsl:template match="/darcs/directory">-    <xsl:call-template name="show-patch-info">-      <xsl:with-param name="patch" select="modified/patch"/>-    </xsl:call-template>--    <table>-      <tr class="annotate">-        <th>file</th>-        <th>change</th>-        <th></th>-        <th></th>-      </tr>--      <xsl:apply-templates/>-    </table>-  </xsl:template>-  -  <xsl:template match="directory/modified/modified_how">-    <xsl:variable name="hash" select="../patch/@hash" />-    <xsl:variable name="how" select="substring(text(), 0, 10)"/>-    <xsl:variable name="target" select="/darcs/@target"/>--    <!---      annotating a directory outputs the directory itself as well as-      any contents.  this ugly code checks if the matching element is-      the original directory so that the 'annotate' and 'patch' links-      don't append the directory twice.-    -->-    <xsl:variable name="last" select="//darcs/path/directory[last()]"/>-    <xsl:variable name="name" select="../../@name"/>-    <xsl:variable name="dir">-      <xsl:choose>-        <xsl:when test="$last = $name"></xsl:when>-        <xsl:otherwise><xsl:value-of select="$name"/>/</xsl:otherwise>-      </xsl:choose>-    </xsl:variable>--    <tr class="add-remove-file">-      <td><xsl:value-of select="$name"/></td>-      <td>-        <xsl:choose>-          <xsl:when test="$how = 'Dir added'">added directory</xsl:when>-          <xsl:when test="$how = 'Dir moved'">moved directory</xsl:when>-          <xsl:when test="$how = 'Dir remov'">removed directory</xsl:when>-        </xsl:choose>-      </td>-      <td>-        <a href="{$command}{$dir}?c=annotate&amp;p={$hash}">annotate</a>-      </td>-      <td><a href="{$command}{$dir}?c=patches">patches</a></td>-    </tr>-  </xsl:template>--  <xsl:template match="directory/file/modified/modified_how">-    <xsl:variable name="file" select="../../@name"/>-    <xsl:variable name="hash" select="../patch/@hash" />-    <xsl:variable name="how" select="substring(text(), 0, 11)"/>-    -    <tr class="add-remove-file">-      <td><xsl:value-of select="$file"/></td>-      <td>-        <xsl:choose>-          <xsl:when test="$how = 'File added'">added file</xsl:when>-          <xsl:when test="$how = 'File moved'">moved file</xsl:when>-          <xsl:when test="$how = 'File remov'">removed file</xsl:when>-        </xsl:choose>-      </td>-      <td><a href="{$command}{$file}?c=annotate&amp;p={$hash}">annotate</a></td>-      <td><a href="{$command}{$file}?c=patches">patches</a></td>-    </tr>-  </xsl:template>-   -  <!-- file annotate templates -->-  <xsl:template match="/darcs/file">-    <xsl:variable name="modified_how" select="modified/modified_how/text()"/>-    -    <xsl:call-template name="show-patch-info">-      <xsl:with-param name="patch" select="modified/patch"/>-    </xsl:call-template>--    <!-- don't display table of changes when file's contents are modified -->-    <xsl:if test="$modified_how != 'File modified'">-      <xsl:variable name="file" select="@name"/>-      <xsl:variable name="how" select="substring($modified_how, 0, 11)"/>--      <xsl:variable name="annotate-href">-        <xsl:call-template name="make-annotate-href">-          <xsl:with-param name="hash" select="modified/patch/@hash"/>-        </xsl:call-template>-      </xsl:variable>-      -      <table>-        <tr class="annotate">-          <th>file</th>-          <th>change</th>-          <th></th>-          <th></th>-        </tr>--        <tr class="add-remove-file">-          <td><xsl:value-of select="$file"/></td>-          <td>-            <xsl:choose>-              <xsl:when test="$how = 'File added'">added file</xsl:when>-              <xsl:when test="$how = 'File moved'">moved file</xsl:when>-              <xsl:when test="$how = 'File remov'">removed file</xsl:when>-            </xsl:choose>-          </td>-          <td><a href="{$annotate-href}">annotate</a></td>-          <td><a href="{$command}?c=patches">patches</a></td>-        </tr>-      </table>-    </xsl:if>--    <!-- the empty <p/> element is a Konqueror bug workaround -->-    <pre xml:space="preserve"><p/>-      <xsl:apply-templates/>-    </pre>-  </xsl:template>-  -  <xsl:template match="added_line">-    <xsl:variable name="annotate-href">-      <xsl:call-template name="make-annotate-href">-        <xsl:with-param name="hash" select="preceding::modified/patch/@hash"/>-      </xsl:call-template>-    </xsl:variable>--    <xsl:variable name="annotate-name" select="preceding::modified/patch/name"/>-    <xsl:variable name="author" select="preceding::modified/patch/@author"/>-    -    <a class="added-line" href="{$annotate-href}" title="added with '{$annotate-name}' by '{$author}'">-      <pre><xsl:value-of select="text()"/></pre>-    </a>-    <xsl:call-template name="check-removed-by"/>-  </xsl:template>--  <xsl:template match="normal_line">-    <xsl:variable name="annotate-href">-      <xsl:call-template name="make-annotate-href">-        <xsl:with-param name="hash" select="*/patch/@hash"/>-      </xsl:call-template>-    </xsl:variable>--    <xsl:variable name="annotate-name" select="*/patch/name"/>-    <xsl:variable name="author" select="*/patch/@author"/>--    <a class="normal-line" href="{$annotate-href}" title="last changed with '{$annotate-name}' by '{$author}'">-      <pre><xsl:value-of select="text()"/></pre>-    </a>-    <xsl:call-template name="check-removed-by"/>-  </xsl:template>--  <xsl:template match="removed_line">-    <xsl:variable name="annotate-href">-      <xsl:call-template name="make-annotate-href">-        <xsl:with-param name="hash" select="*/patch/@hash"/>-      </xsl:call-template>-    </xsl:variable>--    <xsl:variable name="annotate-name" select="*/patch/name"/>-    <xsl:variable name="author" select="*/patch/@author"/>-    -    <!-- don't display removed lines when a file is removed -->-    <xsl:if test="../modified/modified_how/text() != 'File removed'">-      -        <a class="removed-line" href="{$annotate-href}" title="removed with '{$annotate-name}' by '{$author}'">-        <pre><xsl:value-of select="text()"/></pre>-      </a>-      <xsl:call-template name="check-removed-by"/>-    </xsl:if>-  </xsl:template>--  <xsl:template name="check-removed-by">-    <xsl:variable name="hash" select="removed_by/patch/@hash"/>-    -    <xsl:variable name="annotate-href">-      <xsl:call-template name="make-annotate-href">-        <xsl:with-param name="hash" select="$hash"/>-      </xsl:call-template>-    </xsl:variable>-    -    <xsl:choose>-      <xsl:when test="$hash != ''">-        <a class="removed-by" href="{$annotate-href}">-</a>-      </xsl:when>-    </xsl:choose>--    <!-- put a newline after the hyperlink -->      -    <xsl:text xml:space="preserve">-    </xsl:text>-  </xsl:template>--  <xsl:template name="show-patch-info">-    <xsl:param name="patch"/>-    <xsl:param name="show-comment"/>-    <xsl:param name="show-author"/>-    <xsl:param name="show-date"/>-    -    <xsl:variable name="hash" select="$patch/@hash"/>-    <xsl:variable name="name" select="$patch/name"/>-    <xsl:variable name="author" select="$patch/@author"/>-    <xsl:variable name="local_date" select="$patch/@local_date"/>-    -    <h2 class="patch">-      patch "<span class="path">-      <a href="{$cgi-program}/{$repo}/?c=annotate&amp;p={$hash}">-        <xsl:value-of select="$name"/>-      </a>-      </span>"-    </h2>--    <xsl:if test="$show-comment">-        <xsl:if test="$patch/comment">-          <h2 class="patch">-            comment "<span class="comment">-            <xsl:value-of select="$patch/comment"/>-            </span>"-            </h2>-        </xsl:if>-        </xsl:if>--      <xsl:if test="$show-author"> -          <h2 class="author">-        by <span class="author">-        <xsl:value-of select="$patch/@author"/>-        </span>--      <xsl:if test="$show-date"> -        on <span class="local_date">-        <xsl:value-of select="$patch/@local_date"/>-        </span>-    </xsl:if>-    </h2>-    </xsl:if>--  </xsl:template>--  <xsl:template name="make-annotate-href" xml:space="default">-    <xsl:param name="hash"/>--    <xsl:variable name="created-as" select="/darcs/*/created_as"/>-    <xsl:variable name="creator-hash" select="$created-as/patch/@hash"/>-    <xsl:variable name="original-name" select="$created-as/@original_name"/>-    -    <xsl:value-of select="$command"/>?c=annotate&amp;p=<xsl:value-of select="$hash"/>&amp;ch=<xsl:value-of select="$creator-hash"/>&amp;o=<xsl:value-of select="$original-name"/>-  </xsl:template>--  <!-- ignore <name>, <comment> and <modified_how> children -->-  <xsl:template match="name"/>-  <xsl:template match="comment"/>-  <xsl:template match="author"/>-  <xsl:template match="modified_how"/>-</xsl:stylesheet>
− tools/cgi/xslt/browse.xslt 
@@ -1,110 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>--<!--- template for converting a darcs current/ directory listing from XML to- XHTML.  This template expects the following external variables:--   cgi-program    - path to the CGI executable, to place in links-   sort-by        - field to sort by-   stylesheet     - path to the CSS stylesheet-- the input XML must have the following structure, aside from what common.xslt- expects:-- <files>-   <directory name="" modified=""/>-   <file name="" modified=""/>- </files>--->-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">-  <xsl:include href="common.xslt"/>--  <xsl:template match="path">-    <h1 class="target">-      files in <span class="path"><a href="{$cgi-program}">projects</a></span> / <span class="path"><xsl:apply-templates/></span>-    </h1>-  </xsl:template>-  -  <xsl:template match="files">-    <table>-      <tr class="browse">-        <th>-          <a class="sort" href="{$command}?c=browse&amp;s=name">name</a>-          <a class="revsort" href="{$command}?c=browse&amp;s=revname"> (rev)</a>-        </th>-        <th>-          <a class="sort" href="{$command}?c=browse&amp;s=ts">modified</a>-          <a class="revsort" href="{$command}?c=browse&amp;s=revts"> (rev)</a>-        </th>-        <th></th>-        <th></th>-      </tr>-      -      <xsl:choose>-        <xsl:when test="$sort-by = 'ts'">-          <xsl:apply-templates>-            <xsl:sort select="name(self::node())"/>-            <xsl:sort select="@ts"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'revts'">-          <xsl:apply-templates>-            <xsl:sort select="name(self::node())"/>-            <xsl:sort select="@ts" order="descending"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'name'">-          <xsl:apply-templates>-            <xsl:sort select="name(self::node())"/>-            <xsl:sort select="@name"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'revname'">-          <xsl:apply-templates>-            <xsl:sort select="name(self::node())"/>-            <xsl:sort select="@name" order="descending"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:otherwise>-          <xsl:apply-templates>-            <xsl:sort select="name(self::node())"/>-            <xsl:sort select="@name"/>-          </xsl:apply-templates>-        </xsl:otherwise>-      </xsl:choose>-    </table>-  </xsl:template>-  -  <xsl:template match="directory">-    <xsl:variable name="name" select="@name"/>-    <xsl:variable name="type" select="@type"/>-    -    <tr class="directory">-      <td>-        <a href="{$command}{$name}?c=browse"><xsl:value-of select="@name"/></a>-      </td>-      <td><xsl:value-of select="@modified"/></td>-      <td>-        <a href="{$command}{$name}?c=annotate">annotate</a>-      </td>-      <td>-        <a href="{$command}{$name}?c=patches">patches</a>-      </td>-    </tr>--    <xsl:apply-templates/>-  </xsl:template>--  <xsl:template match="file">-    <xsl:variable name="name" select="@name"/>-    -    <tr class="file">-      <td><xsl:value-of select="@name"/></td>-      <td><xsl:value-of select="@modified"/></td>-      <td><a href="{$command}{$name}?c=annotate">annotate</a></td>-      <td><a href="{$command}{$name}?c=patches">patches</a></td>-    </tr>--    <xsl:apply-templates/>-  </xsl:template>-</xsl:stylesheet>
− tools/cgi/xslt/common.xslt 
@@ -1,66 +0,0 @@-<!--- templates fragments shared by all templates.  This template expects- the following external variables:--   cgi-program    - path to the CGI executable, to place in links-   stylesheet     - path to the CSS stylesheet-- the input XML must have the following structure, plus any elements- that are not common to all templates:-- <darcs repository="">-   <path>-     <element full-path=""></element>-   </path>--   ...- - </darcs>--->-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">-  <xsl:variable name="command">-    <xsl:value-of select="$cgi-program"/>/<xsl:value-of select="/darcs/@target"/>-  </xsl:variable>--  <xsl:variable name="repo" select="/darcs/@repository"/>-  -  <xsl:template match="/darcs">-    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">-      <head>-        <title>darcs repository</title>-        <link rel="stylesheet" href="{$stylesheet}"/>-        <link rel="alternate" type="application/rss+xml" title="RSS 2.0" href="{$command}?c=rss" />-      </head>--      <body>-        <xsl:apply-templates/>--        <form action="{$command}" method="get">-          <p>-            <input class="patches" type="submit" name="c" value="patches"/>-            -            <a href="{$command}?c=rss">rss</a>-            -            <span class="version">-              <a class="home" href="http://darcs.net/">darcs.cgi</a>-              v1.0-            </span>-          </p>-        </form>-      </body>-    </html>-  </xsl:template>--  <xsl:template match="path/directory">-    <xsl:variable name="full-path"  select="@full-path"/>-    -    <a href="{$cgi-program}{$full-path}?c=browse">-      <xsl:apply-templates/>-    </a> /-  </xsl:template>--  <xsl:template match="path/file">-    <xsl:apply-templates/>-  </xsl:template>-  -</xsl:stylesheet>
− tools/cgi/xslt/errors.xml 
@@ -1,22 +0,0 @@-<!---  HTML templates for all potential error pages.  Each <error> element-  should contain all of the HTML <body> content to be output if that-  error occurs--->-<errors>-  <error type="invalid-command" title="Invalid command">-    <h1>Invalid command</h1>--    <p>-      The requested command is invalid.-    </p>-  </error>--  <error type="invalid-repository" title="Invalid repository">-    <h1>Invalid repository</h1>--    <p>-      The requested repository does not exist on this server.-    </p>-  </error>-</errors>
− tools/cgi/xslt/errors.xslt 
@@ -1,36 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>--<!--- template for converting selected content of errors.xml XML to XHTML. This- template expects the following external variables:--   error-type     - the type of error-   stylesheet     - path to the CSS stylesheet-- the input XML must have the following structure-- <errors>-   <error type="" title="">-     ...-   </error>- </errors>--->-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">-  <xsl:template match="error[@type = $error-type]">-    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">-      <head>-        <title>-          <xsl:value-of select="@title"/>-        </title>-        <link rel="stylesheet" href="{$stylesheet}"/>-      </head>--      <body>-        <xsl:copy-of select="*"/>-      </body>-    </html>-  </xsl:template>--  <!-- ignore errors that don't match -->-  <xsl:template match="error"/>-</xsl:stylesheet>
− tools/cgi/xslt/patches.xslt 
@@ -1,125 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>--<!--- template for converting darcs' `changes` output from XML to XHTML.  This- template expects the following external variables:--   cgi-program    - path to the CGI executable, to place in links-   sort-by        - field to sort by-   stylesheet     - path to the CSS stylesheet-- the input XML must have the following structure, aside from what common.xslt- expects:-- <changelog>-   <patch author="" date="" localdate="" inverted="" hash="">-     <name></name>-   </patch>- </changelog>--->-<xsl:stylesheet version="1.0"-                xmlns:xsl="http://www.w3.org/1999/XSL/Transform"-                xmlns:str="http://exslt.org/strings">-  -  <xsl:include href="common.xslt"/>--  <xsl:template match="path">-    <h1 class="target">-      patches applied to <span class="path"><a href="{$cgi-program}">projects</a></span> / <span class="path"><xsl:apply-templates/></span>-    </h1>-  </xsl:template>-  -  -  <xsl:template match="changelog">-    <table>-      <tr class="patches">-        <th>-          <a class="sort" href="{$command}?c=patches&amp;s=name">name</a>-          <a class="revsort" href="{$command}?c=patches&amp;s=revname"> (rev)</a>-        </th>-        <th>-          <a class="sort" href="{$command}?c=patches&amp;s=date">date</a>-          <a class="revsort" href="{$command}?c=patches&amp;s=revdate"> (rev)</a>-        </th>-        <th>-          <a class="sort" href="{$command}?c=patches&amp;s=author">author</a>-          <a class="revsort" href="{$command}?c=patches&amp;s=revauthor"> (rev)</a>-        </th>-        <th>-        </th>-      </tr>--      <xsl:choose>-        <xsl:when test="$sort-by = 'name'">-          <xsl:apply-templates>-            <xsl:sort select="name"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'revname'">-          <xsl:apply-templates>-            <xsl:sort select="name" order="descending"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'date'">-          <xsl:apply-templates>-            <xsl:sort select="@date"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'revdate'">-          <xsl:apply-templates>-            <xsl:sort select="@date" order="descending"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'author'">-          <xsl:apply-templates>-            <xsl:sort select="@author"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:when test="$sort-by = 'revauthor'">-          <xsl:apply-templates>-            <xsl:sort select="@author" order="descending"/>-          </xsl:apply-templates>-        </xsl:when>-        <xsl:otherwise>-          <!-- use the repository's natural order -->-          <xsl:apply-templates/>-        </xsl:otherwise>-      </xsl:choose>-    </table>-  </xsl:template>--  <xsl:template match="patch">-    <xsl:variable name="author" select="@author"/>-    <xsl:variable name="hash"   select="@hash"/>-    <xsl:variable name="name"   select="name"/>-    <xsl:variable name="repo"   select="/darcs/@repository"/>--    <xsl:variable name="created-as" select="/darcs/changelog/created_as"/>-    <xsl:variable name="creator-hash" select="$created-as/patch/@hash"/>-    <xsl:variable name="original-name" select="$created-as/@original_name"/>--    <xsl:variable name="annotate-href">-      <xsl:value-of select="$command"/>?c=annotate&amp;p=<xsl:value-of select="$hash"/>--      <xsl:if test="$creator-hash">&amp;ch=<xsl:value-of select="$creator-hash"/></xsl:if>-      <xsl:if test="$original-name">&amp;o=<xsl:value-of select="$original-name"/></xsl:if>-    </xsl:variable>-    -    <tr class="patch">-      <td><a href="{$annotate-href}"><xsl:value-of select="name"/></a></td>-      <td><xsl:value-of select="@local_date"/></td>-      <td>-        <a href="mailto:{$author}"><xsl:value-of select="$author"/></a>-      </td>-      <td>-        <a href="{$cgi-program}/{$repo}/?c=annotate&amp;p={$hash}">detail</a>-      </td>-    </tr>-    <xsl:apply-templates/>-  </xsl:template>--  <!-- ignore <created_as>, <name> and <comment> children of <patch> -->-  <xsl:template match="created_as"/>-  <xsl:template match="name"/>-  <xsl:template match="comment"/>-</xsl:stylesheet>
− tools/cgi/xslt/repos.xslt 
@@ -1,59 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>--<!--- template for displaying a list of available repositories, used when a- CGI request has no repository path information.  This template expects- the following external variables:--   cgi-program    - path to the CGI executable, to place in links-   stylesheet     - path to the CSS stylesheet-- the input XML must have the following structure:-- <darcs repository="">-   <repositories>-     <repository name=""/>-   </repositories>- </darcs>--->-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">-  <xsl:variable name="command">-    <xsl:value-of select="$cgi-program"/>/<xsl:value-of select="/darcs/@target"/>-  </xsl:variable>-  -  <xsl:template match="/darcs">-    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">-      <head>-        <title>darcs repository viewer</title>-        <link rel="stylesheet" href="{$stylesheet}"/>-      </head>--      <body>-        <h1 class="target">Available Repositories</h1>--        <table>-          <xsl:apply-templates/>-        </table>-      </body>-    </html>-  </xsl:template>--  <xsl:template match="repositories">-    <xsl:apply-templates>-      <xsl:sort select="name(self::node())"/>-      <xsl:sort select="@name"/>-    </xsl:apply-templates>-  </xsl:template>--  <xsl:template match="repositories/repository">-    <xsl:variable name="repository"  select="@name"/>--    <tr>-      <td>-        <a href="{$cgi-program}/{$repository}/?c=browse">-          <xsl:value-of select="$repository"/>-        </a>-      </td>-    </tr>-  </xsl:template>-</xsl:stylesheet>
− tools/cgi/xslt/rss.xslt 
@@ -1,92 +0,0 @@-<?xml version="1.0" encoding="utf-8"?>--<!--- template for converting darcs' `changes` output from XML to RSS.  This- template expects the following external variables:--   cgi-url    - full URL to the CGI executable, to place in links-- the input XML must have the following structure:-- <darcs repository="">-   <changelog>-     <patch author="" date="" localdate="" inverted="" hash="">-       <name></name>-       <comment></comment>-     </patch>-   </changelog>- </darcs>--->-<xsl:stylesheet version="1.0"-                exclude-result-prefixes="str"-                xmlns:xsl="http://www.w3.org/1999/XSL/Transform"-                xmlns:str="http://exslt.org/strings">--  <xsl:variable name="repo" select="/darcs/@repository"/>--  <xsl:variable name="command">-    <xsl:value-of select="$cgi-url"/>/<xsl:value-of select="/darcs/@target"/>-  </xsl:variable>--  <xsl:template match="changelog">-    <rss version="2.0">-      <channel>-        <title>changes to <xsl:value-of select="$repo"/></title>-        <link><xsl:value-of select="$command"/></link>-        <description>-          Recent patches applied to the darcs repository named-          "<xsl:value-of select='$repo'/>".-        </description>--        <xsl:apply-templates>-          <xsl:sort select="@date"/>-        </xsl:apply-templates>-      </channel>-    </rss>-  </xsl:template>--  <xsl:template match="patch">-    <xsl:variable name="hash"       select="@hash"/>--    <xsl:variable name="created-as" select="/darcs/changelog/created_as"/>-    <xsl:variable name="creator-hash" select="$created-as/patch/@hash"/>-    <xsl:variable name="original-name" select="$created-as/@original_name"/>--    <xsl:variable name="annotate-href">-      <xsl:value-of select="$command"/>?c=annotate&amp;p=<xsl:value-of select="$hash"/>--      <xsl:if test="$creator-hash">&amp;ch=<xsl:value-of select="$creator-hash"/></xsl:if>-      <xsl:if test="$original-name">&amp;o=<xsl:value-of select="$original-name"/></xsl:if>-    </xsl:variable>--    <xsl:variable name="date-nodes" select="str:tokenize(@local_date, ' ')"/>-    <xsl:variable name="rfc-date">-      <xsl:value-of select="$date-nodes[1]"/>-      <xsl:value-of select="', '"/>-      <xsl:if test="$date-nodes[3] &lt; 10">0</xsl:if>-      <xsl:value-of select="$date-nodes[3]"/>-      <xsl:value-of select="' '"/>-      <xsl:value-of select="$date-nodes[2]"/>-      <xsl:value-of select="' '"/>-      <xsl:value-of select="$date-nodes[6]"/>-      <xsl:value-of select="' '"/>-      <xsl:value-of select="$date-nodes[4]"/>-      <xsl:value-of select="' '"/>-      <xsl:value-of select="$date-nodes[5]"/>-    </xsl:variable>--    <item>-      <title><xsl:value-of select="name"/></title>-      <link><xsl:value-of select="$annotate-href"/></link>-      <author><xsl:value-of select="@author"/></author>-      <description><xsl:value-of select="comment"/></description>-      <pubDate><xsl:value-of select="$rfc-date"/></pubDate>-    </item>-  </xsl:template>--  <!-- ignore <path> <created_as>, <name> and <comment> children of <patch> -->-  <xsl:template match="path"/>-  <xsl:template match="created_as"/>-  <xsl:template match="name"/>-  <xsl:template match="comment"/>-</xsl:stylesheet>
− tools/cgi/xslt/styles.css 
@@ -1,91 +0,0 @@-/**- stylesheet for darcs repository browser-**/--a:link, a:visited {-  color: blue;-  text-decoration: none;-}--a:hover { text-decoration: underline; }-a.sort  { color: black; }-a.revsort  { -  color: black;-  font-size: 75%;-}-a.home  { color: #9292C9; }--body { margin: 10px 10px 10px 10px; }--h1.target {-  font-size: 150%;-  font-weight: bold;-}--h2.patch {-  font-size: 125%;-  font-weight: bold;-  margin-top: -10px;-  padding-left: 10px;-}--h2.author {-  font-size: smaller;-  margin-top: -10px;-  font-weight: bold;-  padding-left: 30px;-}--input.patches {  margin-right: 20px; }-label.tag     {  margin-right: 5px; }--span.path, span.path > a { color: #2A2A6B; }--span.version {-  color: #9292C9;  -  margin-left: 75px;-}--span.comment {-  color: #2A2A6B;-  white-space: pre;-}--th,td {-  text-align: left;-  padding: 5px 10px 5px 10px;  -}--tr.annotate { background-color: #FFAAAA; }-tr.browse { background-color: #FFFF99; }-tr.patches { background-color: #AAFFAA; }-tr.directory { background-color: #CFCFCF; }-tr.file, tr.patch, tr.modified-file { background-color: #DCDCDA; }-tr.modified-file, tr.add-remove-file { background-color: #DCDCDA; }--pre {-    margin: 0 0 0 0;-}--a.added-line {-    color: #00AA00;-    float: left;-}--a.normal-line {-    color: #000000;-    float: left;-}--a.removed-line {-    color: #CC0000;-    float: left;-    text-decoration: line-through;-}--a.removed-by {-    clear: right;-    color: #CC0000;-    float: right;-    font-size: 125%;-}
− tools/cygwin-wrapper.bash 
@@ -1,263 +0,0 @@-#! /bin/bash--DIRNAME=`dirname "${0}"`-if [ "${DIRNAME:0:1}" = "/" ] ; then- DARCSPACKAGEDIR="${DIRNAME}"-else- DARCSPACKAGEDIR="${PWD}/${DIRNAME}"-fi--# If the DARCSPACKAGEDIR assignment above doesn't work for some funny reason, -# you could set these variables by hand.  Or fix the script to work -# automatically and submit a patch.--# Should be set to the full Cygwin path to the directory containing the -# putty executables.-putty_binary_dir="${DARCSPACKAGEDIR}"-# Should be set to the full Cygwin path to the directory containing the -# Windows binary "darcs.exe".-darcs_binary_dir="$putty_binary_dir"-# Should be set to the full Cygwin path to the Windows binary-# "darcs.exe".-darcs_binary="${darcs_binary_dir}/realdarcs.exe"--#----------------------------------------------------------------------# Darcs Wrapper for Cygwin-#-# A Bash script that allows Cywin paths on the command line when using-# a version of Darcs compiled for Windows.  Darcs will still use still-# Windows paths internally.-#-#----------------------------------------------------------------------# Usage-# -# Edit this file and set the variables above.  Then, rename this -# script to "darcs" and put it in your PATH somewhere before the -# original binary.-#-# Darcs needs to launch itself for some operations and so the original-# binary needs to be in your Windows PATH.  Do not rename it.-#-#----------------------------------------------------------------------# Known Issues-#-# This script is just a stopgap measure.  Things don't work perfectly.-# We really need a Cygwin build of Darcs.-#-# No path conversion is performed on:-#    - Any preferences set with "setpref"-#    - The "COMMAND" argument to "darcs trackdown"-#-# When Darcs launches external programs, it uses a Windows system call-# to do so.  This means you may not be able to run "hash bang" scripts-# directly.  For example, to run the Bash script "myscript", you'll-# have to tell Darcs to run "bash myscript".-#-# -----------------------------------------------------------------------PATH="$putty_binary_dir:$darcs_binary_dir:${PATH}"--debug=false--cmd="$1"--# Print each argument to stderr on a separate line.  Then exit.-function die() {-   local line-   for line in "$@"; do-      echo "$line" > /dev/stderr-   done-   exit 2-}--# Make sure 'darcs_binary_dir' is set.-if [ ! -d "$darcs_binary_dir" ]; then-   die "Please edit this script and set the 'darcs_binary_dir' variable" \-       "to refer to a valid directory." \-       "      script path = '$0'"  \-       "     darcs_binary_dir = '$darcs_binary_dir'"-fi--# Special case for when the first argument is an option.-if expr match "$cmd" '-' > /dev/null; then-   if $debug; then-      # echo "SIMPLE CASE:"-      for arg in "$@"; do-         echo "  arg = '$arg'"-      done-   else-      # echo about to exec -a darcs "$darcs_binary" "$@"-      exec -a darcs "$darcs_binary" "$@"-   fi-fi--# Shift off the darcs command name-shift--function is_opaque_opt() {-   local opt-   for opt in "${opaque_binary_opts[@]}"; do-      if [ "$opt" == "$1" ]; then-         return 0-      fi-   done-   return 1-}--function is_file_opt() {-   local opt-   for opt in "${file_binary_opts[@]}"; do-      if [ "$opt" == "$1" ]; then-         return 0-      fi-   done-   return 1-}--# Options are not dealt with in a command-specific way.  AFAIK, Darcs-# doesn't use the same option in two different ways, so we should be-# fine.--# List of "opaque" binary options.  These are options where we don't-# treat the option argument like a file.-declare -a opaque_binary_opts=( \-   '--repo-name' \-   '--to-match' '--to-patch' '--to-tag' \-   '--from-match' '--from-patch' '--from-tag' \-   '-t' '--tag' '--tags' '--tag-name' \-   '-p' '--patch' '--patches' \-   '-m' '--patch-name' \-   '--matches' '--match' \-   '--token-chars' \-   '-A' '--author' '--from' '--to' '--cc' \-   '--sign-as' '--creator-hash' \-   '--last' '--diff-opts' \-   '-d' '--dist-name' \-   '--log-file' \-   '--apply-as' \-   )--# List of binary options that take file arguments that need to be converted.-declare -a file_binary_opts=( \-   '--repodir' '--repo' '--sibling' \-   '--context' \-   '--logfile' '-o' '--output' \-   '--external-merge' \-   '--sign-ssl' '--verify' '--verify-ssl' \-   )--# ---------------------------------------------------------------------# The three command categories.  We only use the first one, but the-# others are listed to make sure we've covered everything.  Luckily,-# there aren't any commands that have some args that need to be-# converted and some that don't.--# Commands whose arguments are file paths that need to be translated.-cmds_convert_nonoption_args='|get|put|pull|push|send|apply'--# Commands who's arguments should be left alone.  File paths that-# refer to files in the repo should NOT be converted because they-# are relative paths, which Darcs will handle just fine.  Cygwin-# sometimes makes them absolute paths, which confuses Darcs.-#cmds_no_convert_nonoption_paths='|add|remove|mv|replace|record|whatsnew|changes|setpref|trackdown|amend-record|revert|diff|annotate'--# Commands that don't accept non-option arguments-#cmds_no_nonoption_args='|initialize|tag|check|optimize|rollback|unrecord|unpull|resolve|dist|repair'--# See if we need to convert the non-option args for the current-# command.  This matches some prefix of one of the commands in the-# list.  The match may not be unambiguous, we can rely on Darcs to-# deal with that correctly.-if expr match "$cmds_convert_nonoption_args" ".*|$cmd" > /dev/null; then-   convert_nonoption_args=true-else-   convert_nonoption_args=false-fi--function convert_path() {-   # echo "converting path ${*} ..." >> /tmp/log-   if expr match "$1" '[-@._A-Za-z0-9]*:' > /dev/null; then-      # Some sort of URL or remote ssh pathname ("xxx:/")-      echo "$1"-      # echo "converting path ${*} ... to ${1}" >> /tmp/log-   elif [ "$1" == '.' ]; then-      # Compensate for stupid 'cygpath' behavior.-      echo '.'-      # echo "converting path ${*} ... to ." >> /tmp/log-   else-      cygpath -wl -- "$1"-      # echo "converting path ${*} ... to `cygpath -wl -- ${1}`" >> /tmp/log-   fi-}--declare -a params=("$cmd")--num_nonoption_args=0--while [ $# -gt 0 ]; do-   arg=$1-   shift-   if expr match "$arg" '-' > /dev/null; then-      # It's an option.  Check to see if it's an opaque binary option.--      if expr match "$arg" '.*=' > /dev/null; then-         # The option has an '=' in it.-         opt=`expr match "$arg" '\([^=]*\)'`-         opt_arg=`expr match "$arg" '[^=]*=\(.*\)'`-         if is_opaque_opt "$opt"; then-            true;-         elif is_file_opt "$opt"; then-            opt_arg=`convert_path "$opt_arg"`-         else-            die "darcs-wrapper: I don't think '$opt' accepts an argument." \-                "[ If it does, then there is a bug in the wrapper script. ]"-         fi-         params[${#params[*]}]="$opt=$opt_arg"--      else-         # The option doesn't have an '='-         opt="$arg"-         if is_opaque_opt "$opt"; then-            if [ $# -eq 0 ]; then-               die "darcs-wrapper: I think '$arg' requires an argument." \-                   "[ If it doesn't, then there is a bug in the wrapper script. ]"-            fi-            opt_arg="$1"-            shift-            params[${#params[*]}]="$opt"-            params[${#params[*]}]="$opt_arg"-         elif is_file_opt "$opt"; then-            if [ $# -eq 0 ]; then-               die "darcs-wrapper: I think '$arg' requires an argument." \-                   "[ If it doesn't, then there is a bug in the wrapper script. ]"-            fi-            opt_arg=`convert_path "$1"`-            shift-            params[${#params[*]}]="$opt"-            params[${#params[*]}]="$opt_arg"-         else-            params[${#params[*]}]="$opt"-         fi-      fi--   else-      if $convert_nonoption_args; then-         arg=`convert_path "$arg"`-      fi-      params[${#params[*]}]="$arg"-      (( num_nonoption_args += 1 ))-   fi-done--# DEBUG-if $debug; then-   echo "ARGS:"-   for arg in "${params[@]}"; do-      echo "  arg = '$arg'"-   done-else-   # echo about to exec -a darcs "$darcs_binary" "${params[@]}"-   exec -a darcs "$darcs_binary" "${params[@]}"-fi-
− tools/darcs_completion 
@@ -1,52 +0,0 @@-#-*- mode: shell-script;-*---# darcs command line completion.-# Copyright 2002 "David Roundy" <droundy@abridgegame.org>-#-have darcs &&-_darcs()-{-    local cur-    cur=${COMP_WORDS[COMP_CWORD]}--    COMPREPLY=()--    if (($COMP_CWORD == 1)); then-        COMPREPLY=( $( darcs --commands | grep "^$cur" ) )-        return 0-    fi--    local IFS=$'\n' # So that the following "command-output to array" operation splits only at newlines, not at each space, tab or newline.-    COMPREPLY=( $( darcs ${COMP_WORDS[1]} --list-option | grep "^${cur//./\\.}") )--	# Then, we adapt the resulting strings to be reusable by bash. If we don't-	# do this, in the case where we have two repositories named-	# ~/space in there-0.1 and ~/space in there-0.2, the first completion will-	# give us:-	# bash> darcs push ~/space in there-0.-	# ~/space in there-0.1 ~/space in there-0.2-	# and we have introduced two spaces in the command line (if we try to-	# recomplete that, it won't find anything, as it doesn't know anything-	# starting with "there-0.").-	# printf %q will gracefully add the necessary backslashes.-	#-	# Bash also interprets colon as a separator. If we didn't handle it-	# specially, completing http://example.org/repo from http://e would -	# give us:-	# bash> darcs pull http:http://example.org/repo-	# An option would be to require the user to escape : as \: and we-	# would do the same here. Instead, we return only the part after-	# the last colon that is already there, and thus fool bash. The-	# downside is that bash only shows this part to the user.-    local i=${#COMPREPLY[*]}-    local colonprefixes=${cur%"${cur##*:}"}-    while [ $((--i)) -ge 0 ]; do-      COMPREPLY[$i]=`printf %q "${COMPREPLY[$i]}"`--      COMPREPLY[$i]=${COMPREPLY[$i]#"$colonprefixes"} -    done-    return 0--}-[ "$have" ] && complete -F _darcs -o default darcs-
− tools/update_roundup.pl 
@@ -1,78 +0,0 @@-#!/usr/bin/perl--use strict;-use warnings;--# A script to update the status of an issue in a Roundup bug tracker-# based on the format of a darcs patch name.-# It is intended to be run from a darcs posthook.--# The format we look for is:-#   resolved issue123 -# in the first line of the patch. --use Getopt::Long;--use MIME::Lite;-use XML::Simple;--unless ($ENV{DARCS_PATCHES_XML}) {-    die "DARCS_PATCHES_XML was expected to be set in the environment, but was not found. -          Are you running this from a Darcs 2.0 or newer posthook?"-}--my $xml = eval { XMLin($ENV{DARCS_PATCHES_XML}); };-die "hmmm.. we couldn't parse your XML. The error was: $@"  if $@;--# $xml structure returned looks like this: -#  'patch' => {-#    'resolved issue123: adding t.t' => {-#        'hash' => '20080215033723-20bb4-54f935f89817985a3e98f3de8e8ac9dad5e8e0e5.gz',-#        'inverted' => 'False',-#        'date' => '20080215033723',-#        'author' => 'Mark Stosberg <mark@summersault.com>',-#        'local_date' => 'Thu Feb 14 22:37:23 EST 2008'-#        },-#     'some other patch' => { ... }, --for my $patch_name (keys %{ $xml->{patch} }) {-    my $issue_re = qr/resolved? \s+ (issue\d+)/msxi;--    next unless ($patch_name =~ $issue_re);-    my $issue = $1;-    my $patch = $xml->{patch}{$patch_name};--    # Using the Command Line would be a simpler alternative. -    # my $out = `roundup-admin -i /var/lib/roundup/trackers/darcs set $issue status=resolved-in-unstable`;-    # warn "unexpected output: $out" if $out;--    my $author = $patch->{author};-    # If the Author name contains an @ sign, we take it to be an e-mail address.-    # Otherwise, we default to darcs-devel as the sender. -    my $email = ($author =~ m/\@/) ? $author : 'darcs-devel@darcs.net';--    my $comment = $patch->{comment} ? "\n$patch->{comment}" : '';--    my $patch_name_minus_status = $patch_name; -    $patch_name_minus_status =~ s/$issue_re(:?\s?)//;--     # Each patches can potentially update the status of a different issue, so generates a different e-mail-    my $msg = MIME::Lite->new(-         From     => $email, -         To      =>'bugs@darcs.net',-         #To       =>'mark@stosberg.com',-         Subject  =>"[$issue] [status=resolved-in-unstable]",-         Type     =>'text/plain',-         Data     => qq!The following patch updated the status of $issue to be resolved:--* $patch_name $comment--!-     );-     $msg->send;-     # An alternative to actually sending, for debugging. -     # use File::Slurp;-     # write_file("msg-$patch->{hash}.out",$msg->as_string);-}--
− tools/upload.cgi 
@@ -1,126 +0,0 @@-#!/usr/bin/perl--use strict;-use File::Temp qw/ tempdir tempfile /;--# this is a sample cgi script to accept darcs patches via POST-# it simply takes patches and sends them using sendmail or-# places them in a Maildir style mailbox.--my $tmp_dir;        # temporary directory, when placing patches to maildir-                    # files are linked from $tmp_dir to $maildir-$tmp_dir = "/tmp";--# target email addresses--leave blank to use To: header in patch contents.-my $target_email;--# target repository for patch testing.  Leave blank to use DarcsURL header-# in patch contents.-my $target_repo;--my $sendmail_cmd;   # command to send patches with-$sendmail_cmd = "/usr/sbin/sendmail -i -t $target_email";--my $maildir;        # maildir to put patches to, replace sendmail-#$maildir = "/tmp/maildir";--my $patch_test_cmd; # command to test patches with-$patch_test_cmd = "darcs apply --dry-run --repodir 'TARGETREPO' 'TARGETPATCH'";--my $repo_get_cmd; # command to get testing repo-                  # used only when $target_repo is blank-$repo_get_cmd = "darcs get --lazy --repodir 'TARGETDIR' 'TARGETREPO'";---sub error_page {-    my ($m) = @_;-    print "Status: 500 Error accepting patch\n";-    print "Content-Type: text/plain\n\n";-    print($m || "There was an error processing your request");-    print "\n";-    exit 0;-}--sub success_page {-    print "Content-Type: text/plain\n\n";-    print "Thank you for your contribution!\n";-    exit 0;-}---if ($ENV{CONTENT_TYPE} eq 'message/rfc822') {-    my $m = start_message() or error_page("could not create temporary file");-    my $fh = $m->{fh};-    my ($totalbytes, $bytesread, $buffer);-    do {-        $bytesread = read(STDIN, $buffer, 1024);-        print $fh $buffer;-        $totalbytes += $bytesread;-    } while ($bytesread);-    my $r = end_message($m);-    $r ? error_page($r) : success_page();-} elsif ($ENV{CONTENT_TYPE}) {-    error_page("invalid content type, I expect something of message/rfc822");-} else {-    error_page("This url is for accepting darcs patches.");-}----sub maildir_file {-    my ($tmp_file) = @_;-    my $base_name = sprintf("patch-%d-%d-0000", $$, time());-    my $count = 0;-    until (link("$tmp_file", "$maildir/$base_name")) {-        $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;-        return undef if $count++ > 100;-    }-    return "$maildir/$base_name";-}--sub start_message {-    my ($fh, $fname) = tempfile("$tmp_dir/dpatch".'X'x8, UNLINK => 1) or-        return undef;-    return { fh => $fh, filename => $fname };-}--sub end_message {-    my ($m) = @_;-    close $m->{fh} or return "$!: $m->{filename} - Could not close filehandle";--    unless ($target_repo) {-        # Look for DarcsURL header-        my $darcsurl;-        open(MF,$m->{filename}) or return "$!: $m->{filename} - Could not open file";-        while (<MF>) {-            if (/^DarcsURL: (.+)$/) {-                $darcsurl = $1;-                last;-            }-        }-        close(MF);-        return "Could not find DarcsURL header" unless $darcsurl;--        my $test_dir = tempdir(CLEANUP => 1).'/repo' or-            return "$!: Could not create test directory";-        $repo_get_cmd =~ s/TARGETDIR/$test_dir/;-        $repo_get_cmd =~ s/TARGETREPO/$darcsurl/;-        system("$repo_get_cmd >/dev/null 2>/dev/null") == 0 or-            return "Could not get target repo: '$repo_get_cmd' failed";-        $target_repo = $test_dir;-    }-    $patch_test_cmd =~ s/TARGETREPO/$target_repo/;-    $patch_test_cmd =~ s/TARGETPATCH/$m->{filename}/;-    system("$patch_test_cmd >/dev/null 2>/dev/null") == 0 or-        return "Patch is not valid: '$patch_test_cmd' failed";--    if ($maildir) {-        maildir_file("$m->{filename}") or-            return "$!: Could not create a new file in maildir";-    } else {-        system("$sendmail_cmd < '$m->{filename}'") == 0 or-            return "$!: Could not send mail";-    }--    return 0;-}
− tools/zsh_completion_new 
@@ -1,533 +0,0 @@-#compdef darcs--# The Z Shell is copyright (c) 1992-2004 Paul Falstad, Richard Coleman,-# Zoltán Hidvégi, Andrew Main, Peter Stephenson, Sven Wischnowsky, and-# others.  All rights reserved.  Individual authors, whether or not-# specifically named, retain copyright in all changes; in what follows, they-# are referred to as `the Zsh Development Group'.  This is for convenience-# only and this body has no legal status.  The Z shell is distributed under-# the following licence; any provisions made in individual files take-# precedence.-#-# Permission is hereby granted, without written agreement and without-# licence or royalty fees, to use, copy, modify, and distribute this-# software and to distribute modified versions of this software for any-# purpose, provided that the above copyright notice and the following-# two paragraphs appear in all copies of this software.-#-# In no event shall the Zsh Development Group be liable to any party for-# direct, indirect, special, incidental, or consequential damages arising out-# of the use of this software and its documentation, even if the Zsh-# Development Group have been advised of the possibility of such damage.-#-# The Zsh Development Group specifically disclaim any warranties, including,-# but not limited to, the implied warranties of merchantability and fitness-# for a particular purpose.  The software provided hereunder is on an "as is"-# basis, and the Zsh Development Group have no obligation to provide-# maintenance, support, updates, enhancements, or modifications.--# This completion module is based on section 6.8 of 'A User's Guide to the Z-Shell' -# by Peter Stephenson and on the tla completion module by Jason McCarty.--# EXTENDED_GLOB is required fr pattern backreferences.-setopt EXTENDED_GLOB--local DARCS=$words[1]--# test whether to hide short options from completion-autoload is-at-least-local hide_short-if zstyle -s ":completion:${curcontext}" hide-shortopts hide_short; then-  case $hide_short in-    true|yes|on|1) hide_short='!' ;;-    *) hide_short='' ;;-  esac-else-  is-at-least 4.1 || hide_short='!'-fi----_darcs_main() {-local DARCS=$words[1]-local arguments-local curcontext="$curcontext"--if (( CURRENT > 2 )); then-    local cmd=${words[2]}-    local var_cmd=cmd_${cmd//-/_}-    curcontext="${curcontext%:*:*}:darcs-${cmd}:"-    (( CURRENT-- ))-    shift words--    local short long arg desc action-    short=()-    long=()-    arg=()-    desc=()-    action=()   -    arguments=()-    -    # Collect all help lines which have a leading space.-    local input-    input=(${(f)"$($DARCS $cmd -h)"})-    input=(${input:#[^\ ]*})-    local i-    for (( i=1 ; i <= ${#input} ; i++ )); do-	# Assumption: the the argument descriptions from `darcs cmd -h` -	# have the following format:-	# [spaces]<-f>[spaces][--flag]<=<spaces>argument>[spaces][description]-	[[ "$input[i]" = (#b)' '#(-?|)' '#([^' ']#|)' '#(--[^=' ']#)(=([^' ']#)|)' '#(*) ]] \-		|| _message -e messages "cannot parse command help output." || return 1--	short[i]="$match[1]"-	long[i]="$match[3]"-	arg[i]="$match[5]"-	desc[i]="$match[6]"-	desc[i]="${${desc[i]//\[/\\[}//\]/\\]}" # escape brackets	--	case $arg[i] in-	DIRECTORY)-	  action[i]='_files -/' ;;-	FILE|FILENAME|IDFILE|KEYS)-	  action[i]='_files' ;;-	USERNAME)-	  action[i]='_users' ;;-	EMAIL|FROM)-	  action[i]='_email_addresses' ;;-	*)- 	  action[i]='' ;;- 	esac-    done-    -    # Compute the exludes for _arguments--    local excluded short_excluded long_excluded k--    for (( i=1 ; i <= ${#input} ; i++ )); do-	excluded=()-	for opt (${=excludes[$long[i]]}); do-	    k=$long[(i)$opt]-	    excluded=($excluded $short[k] $long[k])-	done--	# Generate arguments for _arguments.-	# Make long and short options mutually exclusive.-	short_excluded=($long[i] $excluded)-	long_excluded=($short[i] $excluded)-	[ $short[i] ] && arguments=("$arguments[@]"-	    "${hide_short}(${short_excluded})${short[i]}[${desc[i]}]${arg[i]:+:$arg[i]:$action[i]}")-	[ $long[i] ] && arguments=("$arguments[@]"-	    "(${long_excluded})${long[i]}${arg[i]:+=}[${desc[i]}]${arg[i]:+:$arg[i]:$action[i]}")-    done--    arguments=("$arguments[@]" "${(@P)var_cmd-*:FILE:_files}")-else-    local hline-    local -a cmdlist-    _call_program help-commands darcs --help | while read -A hline; do-	(( ${#hline} < 2 )) && continue-	[[ $hline[1] == darcs ]] && continue- 	[[ $hline[1] == Usage: ]] && continue- 	[[ $hline[1] == Use ]] && continue- 	cmdlist=( $cmdlist "${hline[1]}:${hline[2,-1]}" )-     done-    arguments=(':commands:(($cmdlist))')-fi--_arguments -S -A '-*' \-    "$arguments[@]"-}----#-# Command argument definitions-#-local -a cmd_initialize cmd_get-cmd_initialize=()-cmd_get=(':repository:_files -/' ':new repository name:_files -/')--local -a cmd_add cmd_remove cmd_move cmd_replace-cmd_add=('*:new files:_darcs_new_file_or_tree')-cmd_remove=('*:existing controlled files:_darcs_controlled_files -e')-cmd_move=('*:existing controlled files:_darcs_controlled_files -e')-cmd_replace=(':old token:' ':new token:' '*:existing controlled files:_darcs_controlled_files -e')--local -a cmd_record cmd_pull cmd_push cmd_send cmd_apply-cmd_record=('*:controlled files:_darcs_controlled_files')-cmd_pull=(':repository:_darcs_repository_or_tree')-cmd_push=(':repository:_darcs_repository_or_tree')-cmd_send=(':repository:_darcs_repository_or_tree')-cmd_apply=(':patch file:_files')--local -a cmd_whatsnew cmd_changes-cmd_whatsnew=('*:controlled files:_darcs_controlled_files')-cmd_changes=('*:controlled files:_darcs_controlled_files')--local -a cmd_tag cmd_setpref cmd_check cmd_optimize-cmd_tag=()-cmd_setpref=(':preference key:(test predist boringfile binaries)' ':value:_files')-cmd_check=()-cmd_optimize=()--local -a cmd_amend_record cmd_rollback cmd_unrecord cmd_unpull cmd_revert cmd_unrevert-cmd_amend_record=('*:controlled files:_darcs_controlled_files')-cmd_rollback=()-cmd_unrecord=()-cmd_unpull=()-cmd_revert=('*:controlled files:_darcs_controlled_files')-cmd_unrevert=()--local -a cmd_diff cmd_annotate-cmd_diff=('*:controlled files:_darcs_controlled_files')-cmd_annotate=('*:controlled files:_darcs_controlled_files')--local -a cmd_resolve cmd_dist cmd_trackdown cmd_repair-cmd_resolve=()-cmd_dist=()-cmd_trackdown=(':initialization:' ':command:')-cmd_repair=()---#-# Completion functions-#--(( $+functions[_darcs_new_files] )) ||-_darcs_new_files () {-    local -a new_files-    local -a local_files-    local in_tree_head in_tree_tail-    _darcs_make_tree_path in_tree_head in_tree_tail || return 1-    new_files=(${(f)"$(cd $(_darcs_absolute_tree_root)/$in_tree_head; $DARCS whatsnew -sl .)"})  -    new_files=(${${new_files:#[^a]*}//a /})--    local_files=()-    for file ($new_files); do-	[[ $file:h = $in_tree_head && $file:t = ${in_tree_tail}* ]] && local_files+=$file:t-    done--    compset -P '*/'-    _description new_files expl "new files"-    compadd "$expl[@]" "$local_files[@]"-}-----# _darcs_controlled_files [-e|r] [-f|d]-#-# Adds controlled files to the completion. Can take either-# -e or -r as flags which respectively only add the existing-# files or the deleted files. Can take either -f or -d which-# respectively add only the files or directories.-(( $+functions[_darcs_controlled_files] )) ||-_darcs_controlled_files() {-    local abs_root=$(_darcs_absolute_tree_root)-    local only_removed only_existing only_files only_dirs-    zparseopts -E \-	'r=only_removed' 'e=only_existing' \-	'f=only_files' 'd=only_dirs'--    local in_tree_head in_tree_tail-    _darcs_make_tree_path in_tree_head in_tree_tail-    local recorded_dir-    if [[ -d $abs_root/_darcs/current ]]; then-        recorded_dir="$abs_root/_darcs/current/$in_tree_head"-    else-        recorded_dir="$abs_root/_darcs/pristine/$in_tree_head"-    fi-    local -a controlled_files controlled_dirs existing_files existing_dirs -    local -a dir_display_strs removed_dir_display_strs-    controlled_files=${(z)$(print $recorded_dir/$in_tree_tail*(.:t))}-    controlled_dirs=${(z)$(print $recorded_dir/$in_tree_tail*(/:t))}-    existing_files=() existing_dirs=()-    removed_files=() removed_dirs=() -    dir_display_strs=() removed_dir_display_strs=()-    local dir file-    for dir ($controlled_dirs); do-	if [[ -e $abs_root/$in_tree_head/$dir ]]; then-	    existing_dirs+="$dir"-	    dir_display_strs+="$dir/"	-	else-	    removed_dirs+="$dir"-	    removed_dir_display_strs+="$dir/"-	fi-    done-    for file ($controlled_files); do-	if [[ -e $abs_root/$in_tree_head/$file ]]; then-	    existing_files+="$file"-	else-	    removed_files+="$file"-	fi-    done--    compset -P '*/'-    if (( ! ${#only_removed} )); then -	_description controlled_files expl "existing revision controlled files"-	(( ! ${#only_dirs} )) && compadd "$expl[@]" $existing_files-	(( ! ${#only_files} )) \-	    && compadd "$expl[@]" -q -S / -d dir_display_strs -a -- existing_dirs-    fi-    if (( ! ${#only_existing} )); then-	_description removed_files expl "removed revision controlled files"-	(( ! ${#only_dirs} )) && compadd "$expl[@]" $removed_files-	(( ! ${#only_files} )) \-	    && compadd "$expl[@]" -q -S / -d removed_dir_display_strs -a -- removed_dirs-    fi-}--(( $+functions[_darcs_repositories] )) ||-_darcs_repositories() {-    local local_repos_path="$(_darcs_absolute_tree_root)/_darcs/prefs/repos"-    local global_repos_path="$HOME/.darcs/repos"-    local -a local_repos global_repos-    local -a global_repos-    [[ -e $local_repos_path ]] && cat $local_repos_path | read -A local_repos-    [[ -e $global_repos_path ]] && cat $global_repos_path | read -A global_repos-    local_repos=${local_repos:# #}-    global_repos=${global_repos:# #}-    _description repositories expl "repositories"-    (( ${#local_repos} )) && compadd "$expl[@]" -- "$local_repos[@]"-    (( ${#global_repos} )) && compadd "$expl[@]" -- "$global_repos[@]"-}----# Combination completion functions--(( $+functions[_darcs_new_file_or_tree] )) ||-_darcs_new_file_or_tree() {-    local base_dir=$( cd ${$(_darcs_repodir):-.}; pwd -P)-    [[ -z $(_darcs_absolute_tree_root $base_dir) ]] && return 1-    local -a ignored_files-    ignored_files=(_darcs)-    _alternative 'newfiles:new file:_darcs_new_files' \-		 "directories:tree:_path_files -/ -W$base_dir -Fignored_files"-}--(( $+functions[_darcs_repository_or_tree] )) ||-_darcs_repository_or_tree() {-    local -a ignored_files-    ignored_files=(_darcs)-    _alternative 'repository:repository:_darcs_repositories' \-		 "directories:directories:_path_files -/ -Fignored_files"-}---#-# Mutually exclusive options -#--typeset -A excludes-excludes=(-# Output-    --summary                     '--no-summary'-    --no-summary                  '--summary'-    --context                     '          --xml-output --human-readable --unified'-    --xml-output                  '--context              --human-readable --unified'-    --human-readable              '--context --xml-output                  --unified'-    --unified                     '--context --xml-output --human-readable          '--# Verbosity-    --verbose                     '          --quiet --standard-verbosity'-    --quiet                       '--verbose         --standard-verbosity'-    --standard-verbosity          '--verbose --quiet                     '--# Traversal-    --recursive                   '--not-recursive'-    --not-recursive               '--recursive'-    --look-for-adds               '--dont-look-for-adds'-    --dont-look-for-adds          '--look-for-adds'--# Pattern-    --from-match                  '             --from-patch --from-tag'-    --from-patch                  '--from-match              --from-tag'-    --from-tag                    '--from-patch --from-match           '-    --to-match                    '           --to-patch -to-tag'-    --to-patch                    '--to-match            -to-tag'-    --to-tag                      '--to-match --to-patch        '--# Repository Properties-    --plain-pristine-tree         '--no-pristine-tree'-    --no-pristine-tree            '--plain-pristine-tree'-    --parial                      '--complete'-    --complete                    '--partial'-    --compress                    '--dont-compress'-    --dont-compress               '--compress'-    --set-default                 '--no-set-default'-    --no-set-default              '--set-default'--# Logs-    --edit-long-comment           '--skip-long-comment --leave-test-directory'-    --skip-long-comment           '--edit-long-comment --leave-test-directory'-    --prompt-long-comment         '--edit-long-comment --skip-long-comment'--# Security-    --sign                        '       --sign-as --sign-ssl --dont-sign'-    --sign-as                     '--sign           --sign-ssl --dont-sign'-    --sign-ssl                    '--sign --sign-as            --dont-sign'-    --dont-sign                   '--sign --sign-as --sign-ssl            '-    --verify                      '         --verify-ssl --no-verify'-    --verify-ssl                  '--verify              --no-verify'-    --no-verify                   '--verify --verify-ssl            '-    --apply-as                    '--apply-as-myself'-    --apply-as-myself             '--apply-as'--# Conflicts-    --mark-conflicts              '--allow-conflicts --no-resolve-conflicts --dont-allow-conflicts'-    --allow-conflicts             '--mark-conflicts --no-resolve-conflicts --dont-allow-conflicts'-    --no-resolve-conflicts        '--mark-conflicts --allow-conflicts --dont-allow-conflicts'-    --dont-allow-conflicts        '--mark-conflicts --allow-conflicts --no-resolve-conflicts '--# Test-    --test                        '--no-test'-    --no-test                     '--test'-    --leave-test-directory        '--remove-test-directory'-    --remove-test-directory       '--leave-test-directory'--# Misc-    --force                       '--no-force'-    --no-force                    '--force'-    --ask-deps                    '--no-ask-deps'-    --no-ask-deps                 '--ask-deps'-    --date-trick                  '--no-date-trick'-    --no-date-trick               '--date-trick'-    --set-scripts-executable      '--dont-set-scripts-executable'-    --dont-set-scripts-executable '--set-scripts-executable'-)----#-# Utility functions-#--# _darcs_make_tree_path in_tree_head_name in_tree_tail_name path-# Set in_tree_head_name in_tree_tail_name to the corresponding path-# parts from inside the current darcs tree.-_darcs_make_tree_path () {-    [[ -z $3 || $3 = '.' ]] && 3=${PREFIX:-./}-    local _in_tree=$(_darcs_path_from_root ${$(_darcs_repodir):-.}/$3)-    [[ -z $_in_tree ]] && return 1-    4='' 5=''-    if [[ ${3[-1]} = / ]]; then -	4=$_in_tree-    else-	4=$_in_tree:h-	[[ $_in_tree:t != . ]] && 5=$_in_tree:t-    fi-    set -A "$1" "$4"-    set -A "$2" "$5"-}--_darcs_repodir () {-    local index=$words[(i)--repodir*]-    if (( index < CURRENT )); then-	if [[ $words[$index] = --repodir ]]; then-	    (( index++ ))-	    print $words[$index]-	else-	    print ${words[$index]#*=}-	fi-    fi-}--_darcs_absolute_tree_root () {-    local root=$(_darcs_repodir)-    [[ -z $root ]] && root=$(pwd -P)-    while [[ ! $root -ef / ]]; do-	[[ -d $root/_darcs ]] && break-	root="$root/.."-    done-    [[ $root -ef / ]] || print $(cd $root; pwd -P)-}--_darcs_tree_root () {-    local abs=$(_darcs_absolute_tree_root)-    local rel=$(_darcs_relative_path $abs $(pwd -P))-    [[ -n $abs ]] && print $rel-}--# _darcs_paths_from_root name paths-# Sets name to the paths relative to the darcs tree root.-# If no argument is given then the current directory-# is assumed.-_darcs_paths_from_root () {-    local name=$1-    abs=$(_darcs_absolute_tree_root)-    [[ -z $abs ]] && set -A "$name" && return 1-    shift-    1=${1:=$PWD}-    local -a subpaths-    _darcs_filter_for_subpaths subpaths $abs $*-    local i-    for (( i=1; i<=${#subpaths}; i++ )); do-	[[ $subpaths[$i] != '.' ]] && subpaths[$i]="./$subpaths[$i]"-    done-    set -A "$name" "$subpaths[@]"-}--_darcs_path_from_root() {-    local path-    _darcs_paths_from_root path $1-    [[ -n $path ]] && print "$path"-}--# _darcs_filter_for_in_dir name dir paths-# Sets name to the relative paths from dir to the given paths which -# traverse dir. It ignores paths which are not in dir.-_darcs_filter_for_subpaths () {-    local name=$1 dir=$2 -    shift 2-    local p rel-    local -a accepted_paths -    accepted_paths=()-    for p; do-	rel=$(_darcs_path_difference $p $dir)-	[[ -n $rel ]] && accepted_paths+="$rel"-    done-    set -A "$name" "$accepted_paths[@]"-}--# _darcs_path_difference p1 p2-# Print the path from p2 to p1. If p2 is not an ancestor of p1 then it -# prints a blank string. If they point to the same directory then it returns-# a single period. p2 needs to be a directory path.-_darcs_path_difference () {-    local diff=$(_darcs_relative_path $1 $2)-    [[ ${diff%%/*} != .. ]] && print $diff || return 1-}---# Print the a relative path from the second directory to the first,-# defaulting the second directory to $PWD if none is specified.-# Taken from the zsh mailing list.-_darcs_relative_path () {-    2=${2:=$PWD}-    [[ -d $2 && -d $1:h ]] || return 1-    [[ ! -d $1 ]] && 3=$1:t 1=$1:h-    1=$(cd $1; pwd -P)-    2=$(cd $2; pwd -P)-    [[ $1 -ef $2 ]] && print ${3:-.} && return--    local -a cur abs-    cur=(${(s:/:)2})        # Split 'current' directory into cur-    abs=(${(s:/:)1} $3)     # Split target directory into abs--    # Compute the length of the common prefix, or discover a subdiretory:-    integer i=1-    while [[ i -le $#abs && $abs[i] == $cur[i] ]]-    do-	((++i > $#cur)) && print ${(j:/:)abs[i,-1]} && return-    done--    2=${(j:/:)cur[i,-1]/*/..}       # Up to the common prefix directory and-    1=${(j:/:)abs[i,-1]}            # down to the target directory or file--    print $2${1:+/$1}-}--# Code to make sure _darcs is run when we load it-_darcs_main "$@"
− tools/zsh_completion_old 
@@ -1,26 +0,0 @@-#-*- mode: shell-script;-*---# darcs command line completion for zsh -- example-# Copyright 2002 "David Roundy" <droundy@abridgegame.org>-#--# Old zsh compctl style-_darcs_first()-{-    local prefix-    prefix=$1-    reply=( $( darcs --commands | grep "^${prefix}" ) )-}--_darcs_rest()-{-    local first second prefix rest-    prefix=$1-    read -c first second rest-    reply=( $( darcs ${second} --list-option | grep "^${prefix}") )-}-# this would complete on files as well, if first and rest didn't match.-# since darcs does this when passed --list-option, no need-# compctl -F -x 'p[1,1]' -K _darcs_first - 'p[2,-1]' -K _darcs_rest -- darcs-compctl -x 'p[1,1]' -K _darcs_first - 'p[2,-1]' -K _darcs_rest -- darcs-