module Darcs.Repository.Prefs
( addToPreflist
, deleteSources
, getPreflist
, setPreflist
, getGlobal
, environmentHelpHome
, defaultrepo
, getDefaultRepoPath
, addRepoSource
, getPrefval
, setPrefval
, changePrefval
, defPrefval
, writeDefaultPrefs
, boringRegexps
, boringFileFilter
, darcsdirFilter
, FileType(..)
, filetypeFunction
, getCaches
, globalCacheDir
, globalPrefsDirDoc
, globalPrefsDir
, getMotd
, showMotd
, prefsUrl
, prefsDirPath
, prefsFilesHelp
) where
import Prelude ()
import Darcs.Prelude
import Control.Exception ( catch )
import Control.Monad ( unless, when, liftM )
import Data.Char ( toUpper )
import Data.List ( nub, isPrefixOf, union, sortBy, lookup )
import Data.Maybe ( isJust, fromMaybe, mapMaybe, catMaybes, maybeToList )
import qualified Control.Exception as C
import qualified Data.ByteString as B ( empty, null, hPut, ByteString )
import qualified Data.ByteString.Char8 as BC ( unpack )
import System.Directory ( getAppUserDataDirectory, doesDirectoryExist,
createDirectory, doesFileExist )
import System.Environment ( getEnvironment )
import System.FilePath.Posix ( normalise, dropTrailingPathSeparator, (</>) )
import System.IO.Error ( isDoesNotExistError )
import System.IO ( stdout, stderr )
import System.Info ( os )
import Text.Regex ( Regex, mkRegex, matchRegex )
import Darcs.Repository.Cache ( Cache(..), CacheType(..), CacheLoc(..),
WritableOrNot(..), compareByLocality )
import Darcs.Util.External ( gzFetchFilePS , fetchFilePS, Cachable(..))
import Darcs.Repository.Flags( UseCache (..), DryRun (..), SetDefault (..),
RemoteRepos (..) )
import Darcs.Util.Lock( readTextFile, writeTextFile )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Path ( AbsolutePath, ioAbsolute, toFilePath,
getCurrentDirectory )
import Darcs.Util.Printer( hPutDocLn, text )
import Darcs.Util.URL ( isValidLocalPath )
import Darcs.Util.File ( osxCacheDir, xdgCacheDir, removeFileMayNotExist )
windows,osx :: Bool
windows = "mingw" `isPrefixOf` os
osx = os == "darwin"
writeDefaultPrefs :: IO ()
writeDefaultPrefs = do
setPreflist "boring" defaultBoring
setPreflist "binaries" defaultBinaries
setPreflist "motd" []
defaultBoring :: [String]
defaultBoring = map ("# " ++) boringFileInternalHelp ++
[ ""
, "### compiler and interpreter intermediate files"
, "# haskell (ghc) interfaces"
, "\\.hi$", "\\.hi-boot$", "\\.o-boot$"
, "# object files"
, "\\.o$","\\.o\\.cmd$"
, "# profiling haskell"
, "\\.p_hi$", "\\.p_o$"
, "# haskell program coverage resp. profiling info"
, "\\.tix$", "\\.prof$"
, "# fortran module files"
, "\\.mod$"
, "# linux kernel"
, "\\.ko\\.cmd$","\\.mod\\.c$"
, "(^|/)\\.tmp_versions($|/)"
, "# *.ko files aren't boring by default because they might"
, "# be Korean translations rather than kernel modules"
, "# \\.ko$"
, "# python, emacs, java byte code"
, "\\.py[co]$", "\\.elc$","\\.class$"
, "# objects and libraries; lo and la are libtool things"
, "\\.(obj|a|exe|so|lo|la)$"
, "# compiled zsh configuration files"
, "\\.zwc$"
, "# Common LISP output files for CLISP and CMUCL"
, "\\.(fas|fasl|sparcf|x86f)$"
, ""
, "### build and packaging systems"
, "# cabal intermediates"
, "\\.installed-pkg-config"
, "\\.setup-config"
, "# standard cabal build dir, might not be boring for everybody"
, "# ^dist(/|$)"
, "# autotools"
, "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$"
, "# microsoft web expression, visual studio metadata directories"
, "\\_vti_cnf$"
, "\\_vti_pvt$"
, "# gentoo tools"
, "\\.revdep-rebuild.*"
, "# generated dependencies"
, "^\\.depend$"
, ""
, "### version control systems"
, "# cvs"
, "(^|/)CVS($|/)","\\.cvsignore$"
, "# cvs, emacs locks"
, "^\\.#"
, "# rcs"
, "(^|/)RCS($|/)", ",v$"
, "# subversion"
, "(^|/)\\.svn($|/)"
, "# mercurial"
, "(^|/)\\.hg($|/)"
, "# git"
, "(^|/)\\.git($|/)"
, "# bzr"
, "\\.bzr$"
, "# sccs"
, "(^|/)SCCS($|/)"
, "# darcs"
, "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)"
, "# gnu arch"
, "(^|/)(\\+|,)"
, "(^|/)vssver\\.scc$"
, "\\.swp$","(^|/)MT($|/)"
, "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)"
, "# bitkeeper"
, "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)"
, ""
, "### miscellaneous"
, "# backup files"
, "~$","\\.bak$","\\.BAK$"
, "# patch originals and rejects"
, "\\.orig$", "\\.rej$"
, "# X server"
, "\\..serverauth.*"
, "# image spam"
, "\\#", "(^|/)Thumbs\\.db$"
, "# vi, emacs tags"
, "(^|/)(tags|TAGS)$"
, "#(^|/)\\.[^/]"
, "# core dumps"
, "(^|/|\\.)core$"
, "# partial broken files (KIO copy operations)"
, "\\.part$"
, "# waf files, see http://code.google.com/p/waf/"
, "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)"
, "(^|/)\\.lock-wscript$"
, "# mac os finder"
, "(^|/)\\.DS_Store$"
, "# emacs saved sessions (desktops)"
, "(^|.*/)\\.emacs\\.desktop(\\.lock)?$"
]
boringFileInternalHelp :: [String]
boringFileInternalHelp =
[ "This file contains a list of extended regular expressions, one per"
, "line. A file path matching any of these expressions will be filtered"
, "out during `darcs add`, or when the `--look-for-adds` flag is passed"
, "to `darcs whatsnew` and `record`. The entries in "
++ globalPrefsDirDoc ++ "boring (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."
]
darcsdirFilter :: [FilePath] -> [FilePath]
darcsdirFilter = filter (not . isDarcsdir)
isDarcsdir :: FilePath -> Bool
isDarcsdir ('.' : '/' : f) = isDarcsdir f
isDarcsdir "." = True
isDarcsdir "" = True
isDarcsdir ".." = True
isDarcsdir "../" = True
isDarcsdir fp = (darcsdir ++ "/") `isPrefixOf` fp || fp == darcsdir
globalPrefsDir :: IO (Maybe FilePath)
globalPrefsDir = do
env <- getEnvironment
case lookup "DARCS_TESTING_PREFS_DIR" env of
Just d -> return (Just d)
Nothing -> Just `fmap` getAppUserDataDirectory "darcs"
`catchall` return Nothing
globalPrefsDirDoc :: String
globalPrefsDirDoc | windows = "%APPDATA%\\darcs\\"
| otherwise = "~/.darcs/"
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."
]
)
getGlobal :: String -> IO [String]
getGlobal f = do
dir <- globalPrefsDir
case dir of
(Just d) -> getPreffile $ d </> f
Nothing -> return []
globalCacheDir :: IO (Maybe FilePath)
globalCacheDir | windows = ((</> "cache2") `fmap`) `fmap` globalPrefsDir
| osx = ((</> "darcs") `fmap`) `fmap` osxCacheDir
| otherwise = ((</> "darcs") `fmap`) `fmap` xdgCacheDir
tryMakeBoringRegexp :: String -> IO (Maybe Regex)
tryMakeBoringRegexp input = regex `C.catch` handleBadRegex
where
regex = C.evaluate (Just $! mkRegex input)
handleBadRegex :: C.SomeException -> IO (Maybe Regex)
handleBadRegex _ = hPutDocLn stderr warning >> return Nothing
warning = text $ "Warning: Ignored invalid boring regex: " ++ input
boringRegexps :: IO [Regex]
boringRegexps = do
borefile <- defPrefval "boringfile" (darcsdir ++ "/prefs/boring")
localBores <- getPrefLines borefile `catchall` return []
globalBores <- getGlobal "boring"
liftM catMaybes $ mapM tryMakeBoringRegexp $ localBores ++ globalBores
boringFileFilter :: IO ([FilePath] -> [FilePath])
boringFileFilter = filterBoringAndDarcsdir `fmap` boringRegexps
where
filterBoringAndDarcsdir regexps = filter (notBoring regexps . doNormalise)
notBoring regexps file = not $
isDarcsdir file || any (\r -> isJust $ matchRegex r file) regexps
noncomments :: [String] -> [String]
noncomments = filter nonComment
where
nonComment "" = False
nonComment ('#' : _) = False
nonComment _ = True
getPrefLines :: FilePath -> IO [String]
getPrefLines f = removeCRsCommentsAndConflicts `fmap` readTextFile f
where
removeCRsCommentsAndConflicts =
filter notconflict . noncomments . map stripCr
startswith [] _ = True
startswith (x : xs) (y : ys) = x == y && startswith xs ys
startswith _ _ = False
notconflict l
| startswith "v v v v v v v" l = False
| startswith "*************" l = False
| startswith "^ ^ ^ ^ ^ ^ ^" l = False
| otherwise = True
stripCr "" = ""
stripCr "\r" = ""
stripCr (c : cs) = c : stripCr cs
doNormalise :: FilePath -> FilePath
doNormalise = dropTrailingPathSeparator . normalise
data FileType = BinaryFile
| TextFile
deriving (Eq)
defaultBinaries :: [String]
defaultBinaries = map ("# "++) binariesFileInternalHelp ++
[ "\\." ++ regexToMatchOrigOrUpper e ++ "$" | e <- extensions ]
where
regexToMatchOrigOrUpper e = "(" ++ e ++ "|" ++ map toUpper e ++ ")"
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"
]
binariesFileInternalHelp :: [String]
binariesFileInternalHelp =
[ "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 "
++ globalPrefsDirDoc ++ "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."
]
filetypeFunction :: IO (FilePath -> FileType)
filetypeFunction = do
binsfile <- defPrefval "binariesfile" (darcsdir ++ "/prefs/binaries")
bins <- getPrefLines binsfile
`catch`
(\e -> if isDoesNotExistError e then return [] else ioError e)
gbs <- getGlobal "binaries"
let binaryRegexes = map mkRegex (bins ++ gbs)
isBinary f = any (\r -> isJust $ matchRegex r f) binaryRegexes
ftf f = if isBinary $ doNormalise f then BinaryFile else TextFile
return ftf
findPrefsDirectory :: IO (Maybe String)
findPrefsDirectory = do
inDarcsRepo <- doesDirectoryExist darcsdir
return $ if inDarcsRepo
then Just $ darcsdir ++ "/prefs/"
else Nothing
withPrefsDirectory :: (String -> IO ()) -> IO ()
withPrefsDirectory job = findPrefsDirectory >>= maybe (return ()) job
addToPreflist :: String -> String -> IO ()
addToPreflist pref value = withPrefsDirectory $ \prefs -> do
hasprefs <- doesDirectoryExist prefs
unless hasprefs $ createDirectory prefs
pl <- getPreflist pref
writeTextFile (prefs ++ pref) . unlines $ union [value] pl
getPreflist :: String -> IO [String]
getPreflist p = findPrefsDirectory >>=
maybe (return []) (\prefs -> getPreffile $ prefs ++ p)
getPreffile :: FilePath -> IO [String]
getPreffile f = do
hasprefs <- doesFileExist f
if hasprefs then getPrefLines f else return []
setPreflist :: String -> [String] -> IO ()
setPreflist p ls = withPrefsDirectory $ \prefs -> do
haspref <- doesDirectoryExist prefs
when haspref $
writeTextFile (prefs ++ p) (unlines ls)
defPrefval :: String -> String -> IO String
defPrefval p d = fromMaybe d `fmap` getPrefval p
getPrefval :: String -> IO (Maybe String)
getPrefval p = do
pl <- getPreflist prefsDir
return $ case map snd $ filter ((== p) . fst) $ map (break (== ' ')) pl of
[val] -> case words val of
[] -> Nothing
_ -> Just $ tail val
_ -> Nothing
setPrefval :: String -> String -> IO ()
setPrefval p v = do
pl <- getPreflist prefsDir
setPreflist prefsDir $ updatePrefVal pl p v
updatePrefVal :: [String] -> String -> String -> [String]
updatePrefVal prefList p newVal =
filter ((/= p) . fst . break (== ' ')) prefList ++ [p ++ " " ++ newVal]
changePrefval :: String -> String -> String -> IO ()
changePrefval p f t = do
pl <- getPreflist prefsDir
ov <- getPrefval p
let newval = maybe t (\old -> if old == f then t else old) ov
setPreflist prefsDir $ updatePrefVal pl p newval
fixRepoPath :: String -> IO FilePath
fixRepoPath p
| isValidLocalPath p = toFilePath `fmap` ioAbsolute p
| otherwise = return p
defaultrepo :: RemoteRepos -> AbsolutePath -> [String] -> IO [String]
defaultrepo (RemoteRepos rrepos) _ [] =
do case rrepos of
[] -> maybeToList `fmap` getDefaultRepoPath
rs -> mapM fixRepoPath rs
defaultrepo _ _ r = return r
getDefaultRepoPath :: IO (Maybe String)
getDefaultRepoPath = do
defaults <- getPreflist defaultRepoPref
case defaults of
[] -> return Nothing
(d : _) -> Just `fmap` fixRepoPath d
defaultRepoPref :: String
defaultRepoPref = "defaultrepo"
addRepoSource :: String -> DryRun -> RemoteRepos -> SetDefault -> IO ()
addRepoSource r isDryRun (RemoteRepos rrepos) setDefault = (do
olddef <- getPreflist defaultRepoPref
let shouldDoIt = null noSetDefault && greenLight
greenLight = shouldAct && not rIsTmp && (olddef /= [r] || olddef == [])
if shouldDoIt
then setPreflist defaultRepoPref [r]
else when (True `notElem` noSetDefault && greenLight) $
putStr . unlines $ setDefaultMsg
addToPreflist "repos" r) `catchall` return ()
where
shouldAct = isDryRun == NoDryRun
rIsTmp = r `elem` rrepos
noSetDefault = case setDefault of
NoSetDefault x -> [x]
_ -> []
setDefaultMsg =
[ "HINT: if you want to change the default remote repository to"
, " " ++ r ++ ","
, " quit now and issue the same command with the --set-default "
++ "flag."
]
deleteSources :: IO ()
deleteSources = do let prefsdir = darcsdir ++ "/prefs/"
removeFileMayNotExist (prefsdir ++ "sources")
removeFileMayNotExist (prefsdir ++ "repos")
getCaches :: UseCache -> String -> IO Cache
getCaches useCache repodir = do
here <- parsehs `fmap` getPreffile sourcesFile
there <- (parsehs . lines . BC.unpack)
`fmap`
(gzFetchFilePS (repodir </> sourcesFile) Cachable
`catchall` return B.empty)
globalcachedir <- globalCacheDir
let globalcache = if nocache
then []
else case globalcachedir of
Nothing -> []
Just d -> [Cache Directory Writable d]
globalsources <- parsehs `fmap` getGlobal "sources"
thisdir <- getCurrentDirectory
let thisrepo = [Cache Repo Writable $ toFilePath thisdir]
thatrepo = [Cache Repo NotWritable repodir]
tempCache = nub $ thisrepo ++ globalcache ++ globalsources ++ here
++ thatrepo ++ filterExternalSources there
return $ Ca $ sortBy compareByLocality tempCache
where
sourcesFile = darcsdir ++ "/prefs/sources"
parsehs = mapMaybe readln . noncomments
readln l
| "repo:" `isPrefixOf` l = Just (Cache Repo NotWritable (drop 5 l))
| nocache = Nothing
| "cache:" `isPrefixOf` l = Just (Cache Directory Writable (drop 6 l))
| "readonly:" `isPrefixOf` l =
Just (Cache Directory NotWritable (drop 9 l))
| otherwise = Nothing
nocache = useCache == NoUseCache
filterExternalSources there =
if isValidLocalPath repodir
then there
else filter (not . isValidLocalPath . cacheSource) there
getMotd :: String -> IO B.ByteString
getMotd repo = fetchFilePS motdPath (MaxAge 600) `catchall` return B.empty
where
motdPath = repo ++ "/" ++ darcsdir ++ "/prefs/motd"
showMotd :: String -> IO ()
showMotd repo = do
motd <- getMotd repo
unless (B.null motd) $ do
B.hPut stdout motd
putStrLn $ replicate 22 '*'
prefsUrl :: FilePath -> String
prefsUrl r = r ++ "/"++darcsdir++"/prefs"
prefsDir :: FilePath
prefsDir = "prefs"
prefsDirPath :: FilePath
prefsDirPath = darcsdir </> prefsDir
prefsFilesHelp :: [(String,String)]
prefsFilesHelp =
[ ("motd", unlines
[ "The `_darcs/prefs/motd` file may contain a 'message of the day' which"
, "will be displayed to users who clone or pull from the repository without"
, "the `--quiet` option."])
, ("email", unlines
[ "The `_darcs/prefs/email` file is used to provide the e-mail address for"
, "your repository that others will use when they `darcs send` a patch back"
, "to you. The contents of the file should simply be an e-mail address."])
, ("post", unlines
[ "If `_darcs/prefs/post` exists in the target repository, `darcs send ` will"
, "upload to the URL contained in that file, which may either be a `mailto:`"
, "URL, or an `http://` URL. In the latter case, the patch is posted to that URL."])
, ("author", unlines
[ "The `_darcs/prefs/author` file contains the email address (or name) to"
, "be used as the author when patches are recorded in this repository,"
, "e.g. `David Roundy <droundy@abridgegame.org>`. This file overrides the"
, "contents of the environment variables `$DARCS_EMAIL` and `$EMAIL`."])
, ("defaults", unlines
[ "Default values for darcs commands. Each line of this file has the"
, "following form:"
, ""
, " COMMAND FLAG VALUE"
, ""
, "where `COMMAND` is either the name of the command to which the default"
, "applies, or `ALL` to indicate that the default applies to all commands"
, "accepting that flag. The `FLAG` term is the name of the long argument"
, "option without the `--`, i.e. `verbose` rather than `--verbose`."
, "Finally, the `VALUE` option can be omitted if the flag does not involve"
, "a value. If the value has spaces in it, use single quotes, not double"
, "quotes, to surround it. Each line only takes one flag. To set multiple"
, "defaults for the same command (or for `ALL` commands), use multiple lines."
, ""
, "Note that the use of `ALL` easily can have unpredicted consequences,"
, "especially if commands in newer versions of darcs accepts flags that"
, "they did not in previous versions. Only use safe flags with `ALL`."
, ""
, "For example, if your system clock is bizarre, you could instruct darcs to"
, "always ignore the file modification times by adding the following line:"
, ""
, " ALL ignore-times"
, ""
, "There are some options which are meant specifically for use in"
, "`_darcs/prefs/defaults`. One of them is `--disable`. As the name"
, "suggests, this option will disable every command that got it as"
, "argument. So, if you are afraid that you could damage your repositories"
, "by inadvertent use of a command like amend, add the following line:"
, ""
, " amend disable"
, ""
, "Also, a global preferences file can be created with the name"
, "`.darcs/defaults` in your home directory. Options present there will be"
, "added to the repository-specific preferences if they do not conflict."])
, ("sources", unlines
[ "The `_darcs/prefs/sources` file is used to indicate alternative locations"
, "from which to download patches. This file contains lines such as:"
, ""
, " cache:/home/droundy/.cache/darcs"
, " readonly:/home/otheruser/.cache/darcs"
, " repo:http://darcs.net"
, ""
, "This would indicate that darcs should first look in"
, "`/home/droundy/.cache/darcs` for patches that might be missing, and if"
, "the patch is not there, it should save a copy there for future use."
, "In that case, darcs will look in `/home/otheruser/.cache/darcs` to see if"
, "that user might have downloaded a copy, but will not try to save a copy"
, "there, of course. Finally, it will look in `http://darcs.net`. Note that"
, "the `sources` file can also exist in `~/.darcs/`. Also note that the"
, "sources mentioned in your `sources` file will be tried *before* the"
, "repository you are pulling from. This can be useful in avoiding"
, "downloading patches multiple times when you pull from a remote"
, "repository to more than one local repository."
, ""
, "A global cache is enabled by default in your home directory. The cache"
, "allows darcs to avoid re-downloading patches (for example, when doing a"
, "second darcs clone of the same repository), and also allows darcs to use"
, "hard links to reduce disk usage."
, ""
, "Note that the cache directory should reside on the same filesystem as"
, "your 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."])
, ("boring", unlines
[ "The `_darcs/prefs/boring` file may contain a list of regular expressions"
, "describing files, such as object files, that you do not expect to add to"
, "your project. A newly created repository has a boring file that includes"
, "many common source control, backup, temporary, and compiled files."
, ""
, "You may want to have the boring file under version control. To do this"
, "you can use darcs setpref to set the value 'boringfile' to the name of"
, "your desired boring file (e.g. `darcs setpref boringfile .boring`, where"
, "`.boring` is the repository path of a file that has been darcs added to"
, "your repository). The boringfile preference overrides"
, "`_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"
, "`~/.darcs/boring`, which will be used with all of your darcs repositories."
, ""
, "Any file not already managed by darcs and whose repository path"
, "matches any of the boring regular expressions is"
, "considered boring. The boring file is used to filter the files provided"
, "to darcs add, to allow you to use a simple `darcs add newdir newdir/*`"
, "without accidentally adding a bunch of object files. It is also used"
, "when the `--look-for-adds` flag is given to whatsnew or record. Note"
, "that once a file has been added to darcs, it is not considered boring,"
, "even if it matches the boring file filter."])
, ("binaries", unlines
[ "The `_darcs/prefs/binaries` file may contain a list of regular"
, "expressions describing files that should be treated as binary files rather"
, "than text files. Darcs automatically treats files containing characters"
, "`^Z` or `NULL` within the first 4096 bytes as being binary files."
, "You probably will want to have the binaries file under version control."
, "To do this you can use `darcs setpref` to set the value 'binariesfile'"
, "to the name of your desired binaries file"
, "(e.g. `darcs setpref binariesfile ./.binaries`, where `.binaries` is a"
, "file that has been darcs added to your repository). As with the boring"
, "file, you can also set up a `~/.darcs/binaries` file if you like."])
, ("defaultrepo", unlines
[ "Contains the URL of the default remote repository used by commands `pull`,"
, "`push`, `send` and `optimize relink`. Darcs edits this file automatically"
, "or when the flag `--set-default` is used."])
, ("tmpdir", unlines
[ "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`."])
, ("prefs", unlines
[ "Contains the preferences set by the command `darcs setprefs`."
, "Do not edit manually."])
]