Merge branch 'adjustedbranch'

Annex.hs

@@ -136,6 +136,7 @@ data AnnexState = AnnexState
 	, workers :: [Either AnnexState (Async AnnexState)]
 	, concurrentjobs :: Maybe Int
 	, keysdbhandle :: Maybe Keys.DbHandle
+	, cachedcurrentbranch :: Maybe Git.Branch
 	}
 
 newState :: GitConfig -> Git.Repo -> AnnexState
@@ -182,6 +183,7 @@ newState c r = AnnexState
 	, workers = []
 	, concurrentjobs = Nothing
 	, keysdbhandle = Nothing
+	, cachedcurrentbranch = Nothing
 	}
 
 {- Makes an Annex state object for the specified git repo.

Annex/AdjustedBranch.hs

@@ -0,0 +1,419 @@
+{- adjusted branch
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.AdjustedBranch (
+	Adjustment(..),
+	OrigBranch,
+	AdjBranch,
+	originalToAdjusted,
+	adjustedToOriginal,
+	fromAdjustedBranch,
+	getAdjustment,
+	enterAdjustedBranch,
+	adjustToCrippledFileSystem,
+	updateAdjustedBranch,
+	propigateAdjustedCommits,
+) where
+
+import Annex.Common
+import qualified Annex
+import Git
+import Git.Types
+import qualified Git.Branch
+import qualified Git.Ref
+import qualified Git.Command
+import qualified Git.Tree
+import qualified Git.DiffTree
+import Git.Tree (TreeItem(..))
+import Git.Sha
+import Git.Env
+import Git.Index
+import Git.FilePath
+import qualified Git.LockFile
+import Annex.CatFile
+import Annex.Link
+import Annex.AutoMerge
+import Annex.Content
+import qualified Database.Keys
+
+import qualified Data.Map as M
+
+data Adjustment
+	= UnlockAdjustment
+	| LockAdjustment
+	| HideMissingAdjustment
+	| ShowMissingAdjustment
+	deriving (Show, Eq)
+
+reverseAdjustment :: Adjustment -> Adjustment
+reverseAdjustment UnlockAdjustment = LockAdjustment
+reverseAdjustment LockAdjustment = UnlockAdjustment
+reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment
+reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
+
+{- How to perform various adjustments to a TreeItem. -}
+adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem)
+adjustTreeItem UnlockAdjustment ti@(TreeItem f m s)
+	| toBlobType m == Just SymlinkBlob = do
+		mk <- catKey s
+		case mk of
+			Just k -> do
+				Database.Keys.addAssociatedFile k f
+				Just . TreeItem f (fromBlobType FileBlob)
+					<$> hashPointerFile k
+			Nothing -> return (Just ti)
+	| otherwise = return (Just ti)
+adjustTreeItem LockAdjustment ti@(TreeItem f m s)
+	| toBlobType m /= Just SymlinkBlob = do
+		mk <- catKey s
+		case mk of
+			Just k -> do
+				absf <- inRepo $ \r -> absPath $
+					fromTopFilePath f r
+				linktarget <- calcRepo $ gitAnnexLink absf k
+				Just . TreeItem f (fromBlobType SymlinkBlob)
+					<$> hashSymlink linktarget
+			Nothing -> return (Just ti)
+	| otherwise = return (Just ti)
+adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
+	mk <- catKey s
+	case mk of
+		Just k -> ifM (inAnnex k)
+			( return (Just ti)
+			, return Nothing
+			)
+		Nothing -> return (Just ti)
+adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
+
+type OrigBranch = Branch
+type AdjBranch = Branch
+
+adjustedBranchPrefix :: String
+adjustedBranchPrefix = "refs/heads/adjusted/"
+
+serialize :: Adjustment -> String
+serialize UnlockAdjustment = "unlocked"
+serialize LockAdjustment = "locked"
+serialize HideMissingAdjustment = "present"
+serialize ShowMissingAdjustment = "showmissing"
+
+deserialize :: String -> Maybe Adjustment
+deserialize "unlocked" = Just UnlockAdjustment
+deserialize "locked" = Just UnlockAdjustment
+deserialize "present" = Just HideMissingAdjustment
+deserialize _ = Nothing
+
+originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
+originalToAdjusted orig adj = Ref $
+	adjustedBranchPrefix ++ base ++ '(' : serialize adj ++ ")"
+  where
+	base = fromRef (Git.Ref.basename orig)
+
+adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch)
+adjustedToOriginal b
+	| adjustedBranchPrefix `isPrefixOf` bs = do
+		let (base, as) = separate (== '(') (drop prefixlen bs)
+		adj <- deserialize (takeWhile (/= ')') as)
+		Just (adj, Git.Ref.under "refs/heads" (Ref base))
+	| otherwise = Nothing
+  where
+	bs = fromRef b
+	prefixlen = length adjustedBranchPrefix
+
+getAdjustment :: Branch -> Maybe Adjustment
+getAdjustment = fmap fst . adjustedToOriginal
+
+fromAdjustedBranch :: Branch -> OrigBranch
+fromAdjustedBranch b = maybe b snd (adjustedToOriginal b)
+
+originalBranch :: Annex (Maybe OrigBranch)
+originalBranch = fmap fromAdjustedBranch <$> inRepo Git.Branch.current
+
+{- Enter an adjusted version of current branch (or, if already in an
+ - adjusted version of a branch, changes the adjustment of the original
+ - branch).
+ -
+ - Can fail, if no branch is checked out, or perhaps if staged changes
+ - conflict with the adjusted branch.
+ -}
+enterAdjustedBranch :: Adjustment -> Annex ()
+enterAdjustedBranch adj = go =<< originalBranch
+  where
+	go (Just origbranch) = do
+		adjbranch <- preventCommits $ const $ 
+			adjustBranch adj origbranch
+		inRepo $ Git.Command.run
+			[ Param "checkout"
+			, Param $ fromRef $ Git.Ref.base $ adjbranch
+			]
+	go Nothing = error "not on any branch!"
+
+adjustToCrippledFileSystem :: Annex ()
+adjustToCrippledFileSystem = do
+	warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files."
+	whenM (isNothing <$> originalBranch) $
+		void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit
+			[ Param "--quiet"
+			, Param "--allow-empty"
+			, Param "-m"
+			, Param "commit before entering adjusted unlocked branch"
+			]
+	enterAdjustedBranch UnlockAdjustment
+
+adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch
+adjustBranch adj origbranch = do
+	sha <- adjust adj origbranch
+	inRepo $ Git.Branch.update "entering adjusted branch" adjbranch sha
+	return adjbranch
+  where
+	adjbranch = originalToAdjusted origbranch adj
+
+adjust :: Adjustment -> Ref -> Annex Sha
+adjust adj orig = do
+	treesha <- adjustTree adj orig
+	commitAdjustedTree treesha orig
+
+adjustTree :: Adjustment -> Ref -> Annex Sha
+adjustTree adj orig = do
+	let toadj = adjustTreeItem adj
+	treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo
+	return treesha
+
+type CommitsPrevented = Git.LockFile.LockHandle
+
+{- Locks git's index file, preventing git from making a commit, merge, 
+ - or otherwise changing the HEAD ref while the action is run.
+ -
+ - Throws an IO exception if the index file is already locked.
+ -}
+preventCommits :: (CommitsPrevented -> Annex a) -> Annex a
+preventCommits = bracket setup cleanup
+  where
+	setup = do
+		lck <- fromRepo indexFileLock
+		liftIO $ Git.LockFile.openLock lck
+	cleanup = liftIO . Git.LockFile.closeLock
+
+{- Commits a given adjusted tree, with the provided parent ref.
+ -
+ - This should always yield the same value, even if performed in different 
+ - clones of a repo, at different times. The commit message and other
+ - metadata is based on the parent.
+ -}
+commitAdjustedTree :: Sha -> Ref -> Annex Sha
+commitAdjustedTree treesha parent = commitAdjustedTree' treesha parent [parent]
+
+commitAdjustedTree' :: Sha -> Ref -> [Ref] -> Annex Sha
+commitAdjustedTree' treesha basis parents = go =<< catCommit basis
+  where
+	go Nothing = inRepo mkcommit
+	go (Just basiscommit) = inRepo $ commitWithMetaData
+		(commitAuthorMetaData basiscommit)
+		(commitCommitterMetaData basiscommit)
+		mkcommit
+	mkcommit = Git.Branch.commitTree Git.Branch.AutomaticCommit
+		adjustedBranchCommitMessage parents treesha
+
+adjustedBranchCommitMessage :: String
+adjustedBranchCommitMessage = "git-annex adjusted branch"
+
+{- Update the currently checked out adjusted branch, merging the provided
+ - branch into it. -}
+updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool
+updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
+	join $ preventCommits $ \commitsprevented -> go commitsprevented =<< (,)
+		<$> inRepo (Git.Ref.sha tomerge)
+		<*> inRepo Git.Branch.current
+  where
+	go commitsprevented (Just mergesha, Just currbranch) =
+		ifM (inRepo $ Git.Branch.changed currbranch mergesha)
+			( do
+				void $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
+				adjustedtomerge <- adjust adj mergesha
+				ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge)
+					( return $
+						-- Run after commit lock is dropped.
+						ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode)
+							( preventCommits $ \_ ->
+								recommit currbranch mergesha =<< catCommit currbranch
+							, return False
+							)
+					, nochangestomerge
+					)
+			, nochangestomerge
+			)
+	go _ _ = return $ return False
+	nochangestomerge = return $ return True
+
+	{- A merge commit has been made on the adjusted branch.
+	 - Now, re-do it, removing the old version of the adjusted branch
+	 - from its history.
+	 -
+	 - There are two possible scenarios; either some commits
+	 - were made on top of the adjusted branch's adjusting commit,
+	 - or not. Those commits have already been propigated to the
+	 - orig branch, so we can just check if there are commits in the
+	 - orig branch that are not present in tomerge.
+	 -}
+	recommit currbranch mergedsha (Just mergecommit) =
+		ifM (inRepo $ Git.Branch.changed tomerge origbranch)
+			( remerge currbranch mergedsha mergecommit
+				=<< inRepo (Git.Ref.sha origbranch)
+			, fastforward currbranch mergedsha mergecommit
+			)
+	recommit _ _ Nothing = return False
+
+	{- Fast-forward scenario. The mergecommit is changed to a non-merge
+	 - commit, with its parent being the mergedsha. 
+	 - The orig branch can simply be pointed at the mergedsha.
+	 -}
+	fastforward currbranch mergedsha mergecommit = do
+		commitsha <- commitAdjustedTree (commitTree mergecommit) mergedsha
+		inRepo $ Git.Branch.update "fast-forward update of adjusted branch" currbranch commitsha
+		inRepo $ Git.Branch.update "updating original branch" origbranch mergedsha
+		return True
+		
+	{- True merge scenario. -}
+	remerge currbranch mergedsha mergecommit (Just origsha) = do
+	 	-- Update origbranch by reverse adjusting the mergecommit,
+		-- yielding a merge between orig and tomerge.
+		treesha <- reverseAdjustedTree origsha adj
+			-- get 1-parent commit because 
+			-- reverseAdjustedTree does not support merges
+			=<< commitAdjustedTree (commitTree mergecommit) origsha
+		revadjcommit <- inRepo $
+			Git.Branch.commitTree Git.Branch.AutomaticCommit
+				("Merge branch " ++ fromRef tomerge) [origsha, mergedsha] treesha
+		inRepo $ Git.Branch.update "updating original branch" origbranch revadjcommit
+		-- Update currbranch, reusing mergedsha, but making its
+		-- parent be the updated origbranch.
+		adjcommit <- commitAdjustedTree' (commitTree mergecommit) revadjcommit [revadjcommit]
+		inRepo $ Git.Branch.update rebaseOnTopMsg currbranch adjcommit
+		return True
+	remerge _ _ _ Nothing = return False
+
+{- Check for any commits present on the adjusted branch that have not yet
+ - been propigated to the orig branch, and propigate them.
+ -
+ - After propigating the commits back to the orig banch,
+ - rebase the adjusted branch on top of the updated orig branch.
+ -}
+propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex ()
+propigateAdjustedCommits origbranch (adj, currbranch) = 
+	preventCommits $ \commitsprevented -> do
+		join $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
+		
+{- Returns action which will rebase the adjusted branch on top of the
+ - updated orig branch. -}
+propigateAdjustedCommits'
+	:: OrigBranch
+	-> (Adjustment, AdjBranch)
+	-> CommitsPrevented
+	-> Annex (Annex ())
+propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
+	ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch)
+	case ov of
+		Just origsha -> do
+			cv <- catCommit currbranch
+			case cv of
+				Just currcommit -> do
+					v <- newcommits >>= go origsha False
+					case v of
+						Left e -> do
+							warning e
+							return $ return ()
+						Right newparent -> return $
+							rebase currcommit newparent
+				Nothing -> return $ return ()
+		Nothing -> return $ return ()
+  where
+	newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch
+		-- Get commits oldest first, so they can be processed
+		-- in order made.
+		[Param "--reverse"]
+	go parent _ [] = do
+		inRepo $ Git.Branch.update "updating adjusted branch" origbranch parent
+		return (Right parent)
+	go parent pastadjcommit (sha:l) = do
+		mc <- catCommit sha
+		case mc of
+			Just c
+				| commitMessage c == adjustedBranchCommitMessage ->
+					go parent True l
+				| pastadjcommit -> do
+					v <- reverseAdjustedCommit parent adj (sha, c) origbranch
+					case v of
+						Left e -> return (Left e)
+						Right commit -> go commit pastadjcommit l
+			_ -> go parent pastadjcommit l
+	rebase currcommit newparent = do
+		-- Reuse the current adjusted tree,
+		-- and reparent it on top of the new
+		-- version of the origbranch.
+		commitAdjustedTree (commitTree currcommit) newparent
+			>>= inRepo . Git.Branch.update rebaseOnTopMsg currbranch
+
+rebaseOnTopMsg :: String
+rebaseOnTopMsg = "rebasing adjusted branch on top of updated original branch"
+
+{- Reverses an adjusted commit, and commit with provided commitparent,
+ - yielding a commit sha.
+ -
+ - Adjusts the tree of the commitparent, changing only the files that the
+ - commit changed, and reverse adjusting those changes.
+ -
+ - The commit message, and the author and committer metadata are
+ - copied over from the basiscommit. However, any gpg signature
+ - will be lost, and any other headers are not copied either. -}
+reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha)
+reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch
+	| length (commitParent basiscommit) > 1 = return $
+		Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch
+	| otherwise = do
+		treesha <- reverseAdjustedTree commitparent adj csha
+		revadjcommit <- inRepo $ commitWithMetaData
+			(commitAuthorMetaData basiscommit)
+			(commitCommitterMetaData basiscommit) $
+				Git.Branch.commitTree Git.Branch.AutomaticCommit
+					(commitMessage basiscommit) [commitparent] treesha
+		return (Right revadjcommit)
+
+{- Adjusts the tree of the basis, changing only the files that the
+ - commit changed, and reverse adjusting those changes.
+ -
+ - commitDiff does not support merge commits, so the csha must not be a
+ - merge commit. -}
+reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha
+reverseAdjustedTree basis adj csha = do
+	(diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha)
+	let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff
+	let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others
+	adds' <- catMaybes <$>
+		mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds)
+	treesha <- Git.Tree.adjustTree
+		(propchanges changes)
+		adds'
+		(map Git.DiffTree.file removes)
+		basis
+		=<< Annex.gitRepo
+	void $ liftIO cleanup
+	return treesha
+  where
+	reverseadj = reverseAdjustment adj
+	propchanges changes ti@(TreeItem f _ _) =
+		case M.lookup f m of
+			Nothing -> return (Just ti) -- not changed
+			Just change -> adjustTreeItem reverseadj change
+	  where
+		m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $
+			map diffTreeToTreeItem changes
+
+diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem
+diffTreeToTreeItem dti = TreeItem
+	(Git.DiffTree.file dti)
+	(Git.DiffTree.dstmode dti)
+	(Git.DiffTree.dstsha dti)

Annex/Direct.hs

@@ -225,7 +225,7 @@ mergeDirectCommit allowff old branch commitmode = do
 	let merge_msg = d </> "MERGE_MSG"
 	let merge_mode = d </> "MERGE_MODE"
 	ifM (pure allowff <&&> canff)
-		( inRepo $ Git.Branch.update Git.Ref.headRef branch -- fast forward
+		( inRepo $ Git.Branch.update "merge" Git.Ref.headRef branch -- fast forward
 		, do
 			msg <- liftIO $
 				catchDefaultIO ("merge " ++ fromRef branch) $
@@ -462,7 +462,7 @@ switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
   where
 	switch orighead = do
 		let newhead = directBranch orighead
-		maybe noop (inRepo . Git.Branch.update newhead)
+		maybe noop (inRepo . Git.Branch.update "entering direct mode" newhead)
 			=<< inRepo (Git.Ref.sha orighead)
 		inRepo $ Git.Branch.checkout newhead
 
@@ -475,7 +475,7 @@ switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe
 		case v of
 			Just headsha
 				| orighead /= currhead -> do
-					inRepo $ Git.Branch.update orighead headsha
+					inRepo $ Git.Branch.update "leaving direct mode" orighead headsha
 					inRepo $ Git.Branch.checkout orighead
 					inRepo $ Git.Branch.delete currhead
 			_ -> inRepo $ Git.Branch.checkout orighead

Annex/Ingest.hs

@@ -35,6 +35,8 @@ import Logs.Location
 import qualified Annex
 import qualified Annex.Queue
 import qualified Database.Keys
+import qualified Git
+import qualified Git.Branch
 import Config
 import Utility.InodeCache
 import Annex.ReplaceFile
@@ -43,6 +45,7 @@ import Utility.CopyFile
 import Utility.Touch
 import Git.FilePath
 import Annex.InodeSentinal
+import Annex.AdjustedBranch
 
 import Control.Exception (IOException)
 
@@ -309,15 +312,32 @@ forceParams = ifM (Annex.getState Annex.force)
 	)
 
 {- Whether a file should be added unlocked or not. Default is to not,
- - unless symlinks are not supported. annex.addunlocked can override that. -}
+ - unless symlinks are not supported. annex.addunlocked can override that.
+ - Also, when in an adjusted unlocked branch, always add files unlocked.
+ -}
 addUnlocked :: Annex Bool
 addUnlocked = isDirect <||>
 	(versionSupportsUnlockedPointers <&&>
 	 ((not . coreSymlinks <$> Annex.getGitConfig) <||>
-	  (annexAddUnlocked <$> Annex.getGitConfig)
+	  (annexAddUnlocked <$> Annex.getGitConfig) <||>
+	  (maybe False (\b -> getAdjustment b == Just UnlockAdjustment) <$> cachedCurrentBranch)
 	 )
 	)
 
+cachedCurrentBranch :: Annex (Maybe Git.Branch)
+cachedCurrentBranch = maybe cache (return . Just)
+	=<< Annex.getState Annex.cachedcurrentbranch
+  where
+	cache :: Annex (Maybe Git.Branch)
+	cache = do
+		mb <- inRepo Git.Branch.currentUnsafe
+		case mb of
+			Nothing -> return Nothing
+			Just b -> do
+				Annex.changeState $ \s ->
+					s { Annex.cachedcurrentbranch = Just b }
+				return (Just b)
+
 {- Adds a file to the work tree for the key, and stages it in the index.
  - The content of the key may be provided in a temp file, which will be
  - moved into place. -}

Annex/Init.hs

@@ -33,6 +33,7 @@ import Annex.UUID
 import Annex.Link
 import Config
 import Annex.Direct
+import Annex.AdjustedBranch
 import Annex.Environment
 import Annex.Hook
 import Annex.InodeSentinal
@@ -92,10 +93,13 @@ initialize' mversion = do
 	whenM versionSupportsUnlockedPointers $ do
 		configureSmudgeFilter
 		Database.Keys.scanAssociatedFiles
-	ifM (crippledFileSystem <&&> (not <$> isBare) <&&> (not <$> versionSupportsUnlockedPointers))
+	ifM (crippledFileSystem <&&> (not <$> isBare))
-		( do
+		( ifM versionSupportsUnlockedPointers
+			( adjustToCrippledFileSystem
+			, do
 				enableDirectMode
 				setDirect True
+			)
 		-- Handle case where this repo was cloned from a
 		-- direct mode repo
 		, unlessM isBare

Annex/Version.hs

@@ -52,6 +52,9 @@ versionSupportsUnlockedPointers = go <$> getVersion
 	go (Just "6") = True
 	go _ = False
 
+versionSupportsAdjustedBranch :: Annex Bool
+versionSupportsAdjustedBranch = versionSupportsUnlockedPointers
+
 setVersion :: Version -> Annex ()
 setVersion = setConfig versionField
 

Assistant/Sync.hs

@@ -19,7 +19,6 @@ import Assistant.RemoteControl
 import qualified Command.Sync
 import Utility.Parallel
 import qualified Git
-import qualified Git.Branch
 import qualified Git.Command
 import qualified Git.Ref
 import qualified Remote
@@ -79,16 +78,16 @@ reconnectRemotes notifypushes rs = void $ do
 		| Git.repoIsLocal r = True
 		| Git.repoIsLocalUnknown r = True
 		| otherwise = False
-	sync (Just branch) = do
+	sync currentbranch@(Just _, _) = do
-		(failedpull, diverged) <- manualPull (Just branch) gitremotes
+		(failedpull, diverged) <- manualPull currentbranch gitremotes
 		now <- liftIO getCurrentTime
 		failedpush <- pushToRemotes' now notifypushes gitremotes
 		return (nub $ failedpull ++ failedpush, diverged)
 	{- No local branch exists yet, but we can try pulling. -}
-	sync Nothing = manualPull Nothing gitremotes
+	sync (Nothing, _) = manualPull (Nothing, Nothing) gitremotes
 	go = do
 		(failed, diverged) <- sync
-			=<< liftAnnex (inRepo Git.Branch.current)
+			=<< liftAnnex (join Command.Sync.getCurrBranch)
 		addScanRemotes diverged $
 			filter (not . remoteAnnexIgnore . Remote.gitconfig)
 				nonxmppremotes
@@ -133,7 +132,7 @@ pushToRemotes' now notifypushes remotes = do
 		Annex.Branch.commit "update"
 		(,,)
 			<$> gitRepo
-			<*> inRepo Git.Branch.current
+			<*> join Command.Sync.getCurrBranch
 			<*> getUUID
 	let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
 	ret <- go True branch g u normalremotes
@@ -145,9 +144,9 @@ pushToRemotes' now notifypushes remotes = do
 			Pushing (getXMPPClientID r) (CanPush u shas)
 	return ret
   where
-	go _ Nothing _ _ _ = return [] -- no branch, so nothing to do
+	go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
 	go _ _ _ _ [] = return [] -- no remotes, so nothing to do
-	go shouldretry (Just branch) g u rs =  do
+	go shouldretry currbranch@(Just branch, _) g u rs =  do
 		debug ["pushing to", show rs]
 		(succeeded, failed) <- parallelPush g rs (push branch)
 		updatemap succeeded []
@@ -158,7 +157,7 @@ pushToRemotes' now notifypushes remotes = do
 						map Remote.uuid succeeded
 				return failed
 			else if shouldretry
-				then retry branch g u failed
+				then retry currbranch g u failed
 				else fallback branch g u failed
 
 	updatemap succeeded failed = changeFailedPushMap $ \m ->
@@ -166,10 +165,10 @@ pushToRemotes' now notifypushes remotes = do
 			M.difference m (makemap succeeded)
 	makemap l = M.fromList $ zip l (repeat now)
 
-	retry branch g u rs = do
+	retry currbranch g u rs = do
 		debug ["trying manual pull to resolve failed pushes"]
-		void $ manualPull (Just branch) rs
+		void $ manualPull currbranch rs
-		go False (Just branch) g u rs
+		go False currbranch g u rs
 
 	fallback branch g u rs = do
 		debug ["fallback pushing to", show rs]
@@ -227,7 +226,7 @@ syncAction rs a
  - XMPP remotes. However, those pushes will run asynchronously, so their
  - results are not included in the return data.
  -}
-manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Remote], Bool)
+manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
 manualPull currentbranch remotes = do
 	g <- liftAnnex gitRepo
 	let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes

Assistant/Threads/Committer.hs

@@ -227,7 +227,7 @@ commitStaged msg = do
 		Right _ -> do
 			ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit msg
 			when ok $
-				Command.Sync.updateSyncBranch =<< inRepo Git.Branch.current
+				Command.Sync.updateSyncBranch =<< join Command.Sync.getCurrBranch
 			return ok
 
 {- OSX needs a short delay after a file is added before locking it down,

Assistant/Threads/Merger.hs

@@ -17,7 +17,7 @@ import Utility.DirWatcher.Types
 import qualified Annex.Branch
 import qualified Git
 import qualified Git.Branch
-import Annex.AutoMerge
+import qualified Command.Sync
 import Annex.TaggedPush
 import Remote (remoteFromUUID)
 
@@ -72,19 +72,21 @@ onChange file
 			unlessM handleDesynced $
 				queueDeferredDownloads "retrying deferred download" Later
 	| "/synced/" `isInfixOf` file =
-		mergecurrent =<< liftAnnex (inRepo Git.Branch.current)
+		mergecurrent =<< liftAnnex (join Command.Sync.getCurrBranch)
 	| otherwise = noop
   where
 	changedbranch = fileToBranch file
 
-	mergecurrent (Just current)
+	mergecurrent currbranch@(Just b, _)
-		| equivBranches changedbranch current =
+		| equivBranches changedbranch b =
-			whenM (liftAnnex $ inRepo $ Git.Branch.changed current changedbranch) $ do
+			whenM (liftAnnex $ inRepo $ Git.Branch.changed b changedbranch) $ do
 				debug
 					[ "merging", Git.fromRef changedbranch
-					, "into", Git.fromRef current
+					, "into", Git.fromRef b
 					]
-				void $ liftAnnex $ autoMergeFrom changedbranch (Just current) Git.Branch.AutomaticCommit
+				void $ liftAnnex $ Command.Sync.merge
+					currbranch Git.Branch.AutomaticCommit
+					changedbranch
 	mergecurrent _ = noop
 
 	handleDesynced = case fromTaggedBranch changedbranch of

Assistant/Threads/XMPPClient.hs

@@ -25,6 +25,7 @@ import Assistant.Pairing
 import Assistant.XMPP.Git
 import Annex.UUID
 import Logs.UUID
+import qualified Command.Sync
 
 import Network.Protocol.XMPP
 import Control.Concurrent
@@ -33,7 +34,6 @@ import Control.Concurrent.STM (atomically)
 import qualified Data.Text as T
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Git.Branch
 import Data.Time.Clock
 import Control.Concurrent.Async
 
@@ -306,7 +306,7 @@ pull [] = noop
 pull us = do
 	rs <- filter matching . syncGitRemotes <$> getDaemonStatus
 	debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
-	pullone rs =<< liftAnnex (inRepo Git.Branch.current)
+	pullone rs =<< liftAnnex (join Command.Sync.getCurrBranch)
   where
 	matching r = Remote.uuid r `S.member` s
 	s = S.fromList us

Assistant/WebApp/Configurators/Local.hs

@@ -20,7 +20,7 @@ import qualified Annex
 import qualified Git
 import qualified Git.Config
 import qualified Git.Command
-import qualified Git.Branch
+import qualified Command.Sync
 import Config.Files
 import Utility.FreeDesktop
 import Utility.DiskFree
@@ -200,7 +200,7 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
  - immediately pulling from it. Also spawns a sync to push to it as well. -}
 immediateSyncRemote :: Remote -> Assistant ()
 immediateSyncRemote r = do
-	currentbranch <- liftAnnex (inRepo Git.Branch.current)
+	currentbranch <- liftAnnex $ join Command.Sync.getCurrBranch
 	void $ manualPull currentbranch [r]
 	syncRemote r
 

Assistant/XMPP/Git.hs

@@ -27,7 +27,6 @@ import Annex.TaggedPush
 import Annex.CatFile
 import Config
 import Git
-import qualified Git.Branch
 import qualified Types.Remote as Remote
 import qualified Remote as Remote
 import Remote.List
@@ -292,16 +291,15 @@ xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of
 {- Returns the ClientID that it pushed to. -}
 runPush :: (Remote -> Assistant ()) -> NetMessage -> Assistant (Maybe ClientID)
 runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
-	go =<< liftAnnex (inRepo Git.Branch.current)
+	go =<< liftAnnex (join Command.Sync.getCurrBranch)
   where
-	go Nothing = return Nothing
+	go (Just branch, _) = do
-	go (Just branch) = do
 		rs <- xmppRemotes cid theiruuid
 		liftAnnex $ Annex.Branch.commit "update"
 		(g, u) <- liftAnnex $ (,)
 			<$> gitRepo
 			<*> getUUID
-		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
+		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) branch g
 		selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus
 		if null rs
 			then return Nothing
@@ -311,6 +309,7 @@ runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
 						xmppPush cid (taggedPush u selfjid branch r)
 					checkcloudrepos r
 				return $ Just cid
+	go _ = return Nothing
 runPush checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do
 	rs <- xmppRemotes cid theiruuid
 	if null rs

CmdLine/GitAnnex.hs

@@ -38,6 +38,7 @@ import qualified Command.SetPresentKey
 import qualified Command.ReadPresentKey
 import qualified Command.CheckPresentKey
 import qualified Command.ReKey
+import qualified Command.Adjust
 import qualified Command.MetaData
 import qualified Command.View
 import qualified Command.VAdd
@@ -174,6 +175,7 @@ cmds testoptparser testrunner =
 	, Command.ReadPresentKey.cmd
 	, Command.CheckPresentKey.cmd
 	, Command.ReKey.cmd
+	, Command.Adjust.cmd
 	, Command.MetaData.cmd
 	, Command.View.cmd
 	, Command.VAdd.cmd

Command/Adjust.hs

@@ -0,0 +1,41 @@
+{- git-annex command
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Adjust where
+
+import Command
+import Annex.AdjustedBranch
+import Annex.Version
+
+cmd :: Command
+cmd = notBareRepo $ notDirect $ noDaemonRunning $
+	command "adjust" SectionSetup "enter adjusted branch"
+		paramNothing (seek <$$> optParser)
+
+optParser :: CmdParamsDesc -> Parser Adjustment
+optParser _ = 
+	flag' UnlockAdjustment
+		( long "unlock"
+		<> help "unlock annexed files"
+		)
+	{- Not ready yet
+	<|> flag' HideMissingAdjustment
+		( long "hide-missing"
+		<> help "omit annexed files whose content is not present"
+		)
+	-}
+
+seek :: Adjustment -> CommandSeek
+seek = commandAction . start
+
+start :: Adjustment -> CommandStart
+start adj = do
+	unlessM versionSupportsAdjustedBranch $
+		error "Adjusted branches are only supported in v6 or newer repositories."
+	showStart "adjust" ""
+	enterAdjustedBranch adj
+	next $ next $ return True

Command/Merge.hs

@@ -9,8 +9,7 @@ module Command.Merge where
 
 import Command
 import qualified Annex.Branch
-import qualified Git.Branch
+import Command.Sync (prepMerge, mergeLocal, getCurrBranch)
-import Command.Sync (prepMerge, mergeLocal)
 
 cmd :: Command
 cmd = command "merge" SectionMaintenance
@@ -34,4 +33,4 @@ mergeBranch = do
 mergeSynced :: CommandStart
 mergeSynced = do
 	prepMerge
-	mergeLocal =<< inRepo Git.Branch.current
+	mergeLocal =<< join getCurrBranch

Command/Sync.hs

@@ -1,13 +1,16 @@
 {- git-annex command
  -
  - Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
- - Copyright 2011-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Command.Sync (
 	cmd,
+	CurrBranch,
+	getCurrBranch,
+	merge,
 	prepMerge,
 	mergeLocal,
 	mergeRemote,
@@ -43,6 +46,7 @@ import Annex.Drop
 import Annex.UUID
 import Logs.UUID
 import Annex.AutoMerge
+import Annex.AdjustedBranch
 import Annex.Ssh
 import Annex.BloomFilter
 import Utility.Bloom
@@ -95,20 +99,7 @@ seek :: SyncOptions -> CommandSeek
 seek o = allowConcurrentOutput $ do
 	prepMerge
 
-	-- There may not be a branch checked out until after the commit,
+	getbranch <- getCurrBranch 
-	-- or perhaps after it gets merged from the remote, or perhaps
-	-- never.
-	-- So only look it up once it's needed, and once there is a
-	-- branch, cache it.
-	mvar <- liftIO newEmptyMVar
-	let getbranch = ifM (liftIO $ isEmptyMVar mvar)
-		( do
-			branch <- inRepo Git.Branch.current
-			when (isJust branch) $
-				liftIO $ putMVar mvar branch
-			return branch
-		, liftIO $ readMVar mvar
-		)
 	let withbranch a = a =<< getbranch
 
 	remotes <- syncRemotes (syncWith o)
@@ -140,14 +131,49 @@ seek o = allowConcurrentOutput $ do
 	-- Pushes to remotes can run concurrently.
 	mapM_ (commandAction . withbranch . pushRemote o) gitremotes
 
+type CurrBranch = (Maybe Git.Branch, Maybe Adjustment)
+
+{- There may not be a branch checked out until after the commit,
+ - or perhaps after it gets merged from the remote, or perhaps
+ - never.
+ -
+ - So only look it up once it's needed, and once there is a
+ - branch, cache it.
+ -
+ - When on an adjusted branch, gets the original branch, and the adjustment.
+ -}
+getCurrBranch :: Annex (Annex CurrBranch)
+getCurrBranch = do
+	mvar <- liftIO newEmptyMVar
+	return $ ifM (liftIO $ isEmptyMVar mvar)
+		( do
+			currbranch <- inRepo Git.Branch.current
+			case currbranch of
+				Nothing -> return (Nothing, Nothing)
+				Just b -> do
+					let v = case adjustedToOriginal b of
+						Nothing -> (Just b, Nothing)
+						Just (adj, origbranch) ->
+							(Just origbranch, Just adj)
+					liftIO $ putMVar mvar v
+					return v
+		, liftIO $ readMVar mvar
+		)
+
 {- Merging may delete the current directory, so go to the top
  - of the repo. This also means that sync always acts on all files in the
  - repository, not just on a subdirectory. -}
 prepMerge :: Annex ()
 prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
 
-syncBranch :: Git.Ref -> Git.Ref
+merge :: CurrBranch -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
-syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch
+merge (Just b, Just adj) commitmode tomerge =
+	updateAdjustedBranch tomerge (b, adj) commitmode
+merge (b, _) commitmode tomerge =
+	autoMergeFrom tomerge b commitmode
+
+syncBranch :: Git.Branch -> Git.Branch
+syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch . fromAdjustedBranch
 
 remoteBranch :: Remote -> Git.Ref -> Git.Ref
 remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote
@@ -216,50 +242,58 @@ commitStaged commitmode commitmessage = do
 	void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents
 	return True
 
-mergeLocal :: Maybe Git.Ref -> CommandStart
+mergeLocal :: CurrBranch -> CommandStart
-mergeLocal Nothing = stop
+mergeLocal currbranch@(Just branch, madj) = go =<< needmerge
-mergeLocal (Just branch) = go =<< needmerge
   where
 	syncbranch = syncBranch branch
 	needmerge = ifM isBareRepo
 		( return False
 		, ifM (inRepo $ Git.Ref.exists syncbranch)
-			( inRepo $ Git.Branch.changed branch syncbranch
+			( inRepo $ Git.Branch.changed branch' syncbranch
 			, return False
 			)
 		)
 	go False = stop
 	go True = do
 		showStart "merge" $ Git.Ref.describe syncbranch
-		next $ next $ autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit
+		next $ next $ merge currbranch Git.Branch.ManualCommit syncbranch
+	branch' = maybe branch (originalToAdjusted branch) madj
+mergeLocal (Nothing, _) = stop
 
-pushLocal :: Maybe Git.Ref -> CommandStart
+pushLocal :: CurrBranch -> CommandStart
 pushLocal b = do
 	updateSyncBranch b
 	stop
 
-updateSyncBranch :: Maybe Git.Ref -> Annex ()
+updateSyncBranch :: CurrBranch -> Annex ()
-updateSyncBranch Nothing = noop
+updateSyncBranch (Nothing, _) = noop
-updateSyncBranch (Just branch) = do
+updateSyncBranch (Just branch, madj) = do
+	-- When in an adjusted branch, propigate any changes made to it
+	-- back to the original branch.
+	case madj of
+		Just adj -> propigateAdjustedCommits branch
+			(adj, originalToAdjusted branch adj)
+		Nothing -> return ()
 	-- Update the sync branch to match the new state of the branch
-	inRepo $ updateBranch $ syncBranch branch
+	inRepo $ updateBranch (syncBranch branch) branch
 	-- In direct mode, we're operating on some special direct mode
-	-- branch, rather than the intended branch, so update the indended
+	-- branch, rather than the intended branch, so update the intended
 	-- branch.
 	whenM isDirect $
-		inRepo $ updateBranch $ fromDirectBranch branch
+		inRepo $ updateBranch (fromDirectBranch branch) branch
 
-updateBranch :: Git.Ref -> Git.Repo -> IO ()
+updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO ()
-updateBranch syncbranch g = 
+updateBranch syncbranch updateto g = 
 	unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
   where
 	go = Git.Command.runBool
 		[ Param "branch"
 		, Param "-f"
 		, Param $ Git.fromRef $ Git.Ref.base syncbranch
+		, Param $ Git.fromRef $ updateto
 		] g
 
-pullRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
+pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
 pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
 	showStart "pull" (Remote.name remote)
 	next $ do
@@ -276,26 +310,27 @@ pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
  - were committed (or pushed changes, if this is a bare remote),
  - while the synced/master may have changes that some
  - other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup
+mergeRemote :: Remote -> CurrBranch -> CommandCleanup
-mergeRemote remote b = ifM isBareRepo
+mergeRemote remote currbranch = ifM isBareRepo
 	( return True
-	, case b of
+	, case currbranch of
-		Nothing -> do
+		(Nothing, _) -> do
 			branch <- inRepo Git.Branch.currentUnsafe
-			and <$> mapM (merge Nothing) (branchlist branch)
+			mergelisted (pure (branchlist branch))
-		Just thisbranch -> do
+		(Just branch, _) -> do
-			inRepo $ updateBranch $ syncBranch thisbranch
+			inRepo $ updateBranch (syncBranch branch) branch
-			and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b))
+			mergelisted (tomerge (branchlist (Just branch)))
 	)
   where
-	merge thisbranch br = autoMergeFrom (remoteBranch remote br) thisbranch Git.Branch.ManualCommit
+	mergelisted getlist = and <$> 
+		(mapM (merge currbranch Git.Branch.ManualCommit . remoteBranch remote) =<< getlist)
 	tomerge = filterM (changed remote)
 	branchlist Nothing = []
 	branchlist (Just branch) = [branch, syncBranch branch]
 
-pushRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
+pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
-pushRemote _o _remote Nothing = stop
+pushRemote _o _remote (Nothing, _) = stop
-pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpush) $ do
+pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do
 	showStart "push" (Remote.name remote)
 	next $ next $ do
 		showOutput
@@ -339,16 +374,16 @@ pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpus
  - The sync push will fail to overwrite if receive.denyNonFastforwards is
  - set on the remote.
  -}
-pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool
+pushBranch :: Remote -> Git.Branch -> Git.Repo -> IO Bool
 pushBranch remote branch g = tryIO (directpush g) `after` syncpush g
   where
 	syncpush = Git.Command.runBool $ pushparams
 		[ Git.Branch.forcePush $ refspec Annex.Branch.name
-		, refspec branch
+		, refspec $ fromAdjustedBranch branch
 		]
 	directpush = Git.Command.runQuiet $ pushparams
 		[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name
-		, Git.fromRef $ Git.Ref.base $ fromDirectBranch branch
+		, Git.fromRef $ Git.Ref.base $ fromDirectBranch $ fromAdjustedBranch branch
 		]
 	pushparams branches =
 		[ Param "push"

Command/Upgrade.hs

@@ -9,6 +9,8 @@ module Command.Upgrade where
 
 import Command
 import Upgrade
+import Annex.Version
+import Annex.Init
 
 cmd :: Command
 cmd = dontCheck repoExists $ -- because an old version may not seem to exist
@@ -22,5 +24,7 @@ seek = withNothing start
 start :: CommandStart
 start = do
 	showStart "upgrade" "."
+	whenM (isNothing <$> getVersion) $ do
+		initialize Nothing Nothing
 	r <- upgrade False
 	next $ next $ return r

Git/Branch.hs

@@ -48,14 +48,24 @@ currentUnsafe r = parse . firstLine
 changed :: Branch -> Branch -> Repo -> IO Bool
 changed origbranch newbranch repo
 	| origbranch == newbranch = return False
-	| otherwise = not . null <$> diffs
+	| otherwise = not . null
+		<$> changed' origbranch newbranch [Param "-n1"] repo
   where
-	diffs = pipeReadStrict
+
+changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String
+changed' origbranch newbranch extraps repo = pipeReadStrict ps repo
+  where
+	ps =
 		[ Param "log"
 		, Param (fromRef origbranch ++ ".." ++ fromRef newbranch)
-		, Param "-n1"
 		, Param "--pretty=%H"
-		] repo
+		] ++ extraps
+
+{- Lists commits that are in the second branch and not in the first branch. -}
+changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha]
+changedCommits origbranch newbranch extraps repo = 
+	catMaybes . map extractSha . lines
+		<$> changed' origbranch newbranch extraps repo
 	
 {- Check if it's possible to fast-forward from the old
  - ref to the new ref.
@@ -90,7 +100,7 @@ fastForward branch (first:rest) repo =
   where
 	no_ff = return False
 	do_ff to = do
-		update branch to repo
+		update' branch to repo
 		return True
 	findbest c [] = return $ Just c
 	findbest c (r:rs)
@@ -145,7 +155,7 @@ commit commitmode allowempty message branch parentrefs repo = do
 	ifM (cancommit tree)
 		( do
 			sha <- commitTree commitmode message parentrefs tree repo
-			update branch sha repo
+			update' branch sha repo
 			return $ Just sha
 		, return Nothing
 		)
@@ -175,8 +185,17 @@ forcePush :: String -> String
 forcePush b = "+" ++ b
 
 {- Updates a branch (or other ref) to a new Sha. -}
-update :: Branch -> Sha -> Repo -> IO ()
+update :: String -> Branch -> Sha -> Repo -> IO ()
-update branch sha = run 
+update message branch sha = run
+	[ Param "update-ref"
+	, Param "-m"
+	, Param message
+	, Param $ fromRef branch
+	, Param $ fromRef sha
+	]
+
+update' :: Branch -> Sha -> Repo -> IO ()
+update' branch sha = run
 	[ Param "update-ref"
 	, Param $ fromRef branch
 	, Param $ fromRef sha

Git/CatFile.hs

@@ -125,15 +125,17 @@ catCommit h commitref = go <$> catObjectDetails h commitref
 parseCommit :: L.ByteString -> Maybe Commit
 parseCommit b = Commit
 	<$> (extractSha . L8.unpack =<< field "tree")
+	<*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent"))
 	<*> (parsemetadata <$> field "author")
 	<*> (parsemetadata <$> field "committer")
 	<*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)
   where
-	field n = M.lookup (fromString n) fields
+	field n = headMaybe =<< fields n
-	fields = M.fromList ((map breakfield) header)
+	fields n = M.lookup (fromString n) fieldmap
+	fieldmap = M.fromListWith (++) ((map breakfield) header)
 	breakfield l =
 		let (k, sp_v) = L.break (== sp) l
-		in (k, L.drop 1 sp_v)
+		in (k, [L.drop 1 sp_v])
 	(header, message) = separate L.null ls
 	ls = L.split nl b
 

Git/DiffTree.hs

@@ -14,6 +14,7 @@ module Git.DiffTree (
 	diffWorkTree,
 	diffFiles,
 	diffLog,
+	commitDiff,
 ) where
 
 import Numeric
@@ -72,16 +73,23 @@ diffFiles :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 diffFiles = getdiff (Param "diff-files")
 
 {- Runs git log in --raw mode to get the changes that were made in
- - a particular commit. The output format is adjusted to be the same
+ - a particular commit to particular files. The output format
- - as diff-tree --raw._-}
+ - is adjusted to be the same as diff-tree --raw._-}
 diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 diffLog params = getdiff (Param "log")
 	(Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params)
 
+{- Uses git show to get the changes made by a commit.
+ -
+ - Does not support merge commits, and will fail on them. -}
+commitDiff :: Sha -> Repo -> IO ([DiffTreeItem], IO Bool)
+commitDiff ref = getdiff (Param "show")
+	[ Param "--abbrev=40", Param "--pretty=", Param "--raw", Param (fromRef ref) ]
+
 getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 getdiff command params repo = do
 	(diff, cleanup) <- pipeNullSplit ps repo
-	return (parseDiffRaw diff, cleanup)
+	return (fromMaybe (error $ "git " ++ show (toCommand ps) ++ " parse failed") (parseDiffRaw diff), cleanup)
   where
 	ps = 
 		command :
@@ -92,23 +100,24 @@ getdiff command params repo = do
 		params
 
 {- Parses --raw output used by diff-tree and git-log. -}
-parseDiffRaw :: [String] -> [DiffTreeItem]
+parseDiffRaw :: [String] -> Maybe [DiffTreeItem]
 parseDiffRaw l = go l []
   where
-	go [] c = c
+	go [] c = Just c
-	go (info:f:rest) c = go rest (mk info f : c)
+	go (info:f:rest) c = case mk info f of
-	go (s:[]) _ = error $ "diff-tree parse error " ++ s
+		Nothing -> Nothing
+		Just i -> go rest (i:c)
+	go (_:[]) _ = Nothing
 
 	mk info f = DiffTreeItem
-		{ srcmode = readmode srcm
+		<$> readmode srcm
-		, dstmode = readmode dstm
+		<*> readmode dstm
-		, srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha
+		<*> extractSha ssha
-		, dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha
+		<*> extractSha dsha
-		, status = s
+		<*> pure s
-		, file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f
+		<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)
-		}
 	  where
-		readmode = fst . Prelude.head . readOct
+		readmode = fst <$$> headMaybe . readOct
 
 		-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
 		-- All fields are fixed, so we can pull them out of

Git/FilePath.hs

@@ -31,7 +31,7 @@ import qualified System.FilePath.Posix
 
 {- A FilePath, relative to the top of the git repository. -}
 newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
-	deriving (Show, Eq)
+	deriving (Show, Eq, Ord)
 
 {- Path to a TopFilePath, within the provided git repo. -}
 fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath

Git/LockFile.hs

@@ -0,0 +1,78 @@
+{- git lock files
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Git.LockFile where
+
+import Common
+
+#ifndef mingw32_HOST_OS
+import System.Posix.Types
+#else
+import System.Win32.Types
+import System.Win32.File
+#endif
+
+#ifndef mingw32_HOST_OS
+data LockHandle = LockHandle FilePath Fd
+#else
+data LockHandle = LockHandle FilePath HANDLE
+#endif
+
+{- Uses the same exclusive locking that git does.
+ - Throws an IO exception if the file is already locked.
+ -
+ - Note that git's locking method suffers from the problem that
+ - a dangling lock can be left if a process is terminated at the wrong
+ - time.
+ -}
+openLock :: FilePath -> IO LockHandle
+openLock lck = openLock' lck `catchNonAsync` lckerr
+  where
+	lckerr e = do
+		-- Same error message displayed by git.
+		whenM (doesFileExist lck) $
+			hPutStrLn stderr $ unlines
+				[ "fatal: Unable to create '" ++ lck ++ "': " ++ show e
+				, ""
+				, "If no other git process is currently running, this probably means a"
+				, "git process crashed in this repository earlier. Make sure no other git"
+				, "process is running and remove the file manually to continue."
+				]
+		throwM e
+
+openLock' :: FilePath -> IO LockHandle
+openLock' lck = do
+#ifndef mingw32_HOST_OS
+	-- On unix, git simply uses O_EXCL
+	h <- openFd lck ReadWrite (Just 0O666)
+		(defaultFileFlags { exclusive = True })
+	setFdOption h CloseOnExec True
+#else
+	-- It's not entirely clear how git manages locking on Windows,
+	-- since it's buried in the portability layer, and different
+	-- versions of git for windows use different portability layers.
+	-- But, we can be fairly sure that holding the lock file open on
+	-- windows is enough to prevent another process from opening it.
+	--
+	-- So, all that's needed is a way to open the file, that fails
+	-- if the file already exists. Using CreateFile with CREATE_NEW 
+	-- accomplishes that.
+	h <- createFile lck gENERIC_WRITE fILE_SHARE_NONE Nothing
+		cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing
+#endif
+	return (LockHandle lck h)
+
+closeLock :: LockHandle -> IO ()
+closeLock (LockHandle lck h) = do
+#ifndef mingw32_HOST_OS
+	closeFd h
+#else
+	closeHandle h
+#endif
+	removeFile lck

Git/Ref.hs

@@ -31,11 +31,14 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
 		| prefix `isPrefixOf` s = drop (length prefix) s
 		| otherwise = s
 
+{- Gets the basename of any qualified ref. -}
+basename :: Ref -> Ref
+basename = Ref . reverse . takeWhile (/= '/') . reverse . fromRef
+
 {- Given a directory and any ref, takes the basename of the ref and puts
  - it under the directory. -}
 under :: String -> Ref -> Ref
-under dir r = Ref $ dir ++ "/" ++
+under dir r = Ref $ dir ++ "/" ++ fromRef (basename r)
-	(reverse $ takeWhile (/= '/') $ reverse $ fromRef r)
 
 {- Given a directory such as "refs/remotes/origin", and a ref such as
  - refs/heads/master, yields a version of that ref under the directory,

Git/Tree.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
 
 module Git.Tree (
 	Tree(..),
@@ -28,6 +28,8 @@ import qualified Utility.CoProcess as CoProcess
 import Numeric
 import System.Posix.Types
 import Control.Monad.IO.Class
+import qualified Data.Set as S
+import qualified Data.Map as M
 
 newtype Tree = Tree [TreeContent]
 	deriving (Show)
@@ -38,7 +40,7 @@ data TreeContent
 	| RecordedSubTree TopFilePath Sha [TreeContent]
 	-- A subtree that has not yet been recorded in git.
 	| NewSubTree TopFilePath [TreeContent]
-	deriving (Show)
+	deriving (Show, Eq, Ord)
 
 {- Gets the Tree for a Ref. -}
 getTree :: Ref -> Repo -> IO Tree
@@ -107,28 +109,72 @@ mkTreeOutput fm ot s f = concat
 	]
 
 data TreeItem = TreeItem TopFilePath FileMode Sha
-	deriving (Eq)
+	deriving (Show, Eq)
+
+treeItemToTreeContent :: TreeItem -> TreeContent
+treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s
+
+treeItemsToTree :: [TreeItem] -> Tree
+treeItemsToTree = go M.empty
+  where
+	go m [] = Tree $ filter (notElem '/' . gitPath) (M.elems m)
+	go m (i:is)
+		| '/' `notElem` p =
+			go (M.insert p (treeItemToTreeContent i) m) is
+		| otherwise = case M.lookup idir m of
+			Just (NewSubTree d l) ->
+				go (addsubtree idir m (NewSubTree d (c:l))) is
+			_ ->
+				go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is
+	  where
+		p = gitPath i
+		idir = takeDirectory p
+		c = treeItemToTreeContent i
+
+	addsubtree d m t
+		| elem '/' d = 
+			let m' = M.insert d t m
+			in case M.lookup parent m' of
+				Just (NewSubTree d' l) ->
+					let l' = filter (\ti -> gitPath ti /= d) l
+					in addsubtree parent m' (NewSubTree d' (t:l'))
+				_ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t])
+		| otherwise = M.insert d t m
+	  where
+		parent = takeDirectory d
 
 {- Applies an adjustment to items in a tree.
  -
- - While less flexible than using getTree and recordTree, this avoids
+ - While less flexible than using getTree and recordTree,
- - buffering the whole tree in memory.
+ - this avoids buffering the whole tree in memory.
  -}
-adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> Ref -> Repo -> m Sha
+adjustTree
-adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do
+	:: (MonadIO m, MonadMask m)
+	=> (TreeItem -> m (Maybe TreeItem))
+	-- ^ Adjust an item in the tree. Nothing deletes the item.
+	-- Cannot move the item to a different tree.
+	-> [TreeItem]
+	-- ^ New items to add to the tree.
+	-> [TopFilePath]
+	-- ^ Files to remove from the tree.
+	-> Ref
+	-> Repo
+	-> m Sha
+adjustTree adjusttreeitem addtreeitems removefiles r repo =
+	withMkTreeHandle repo $ \h -> do
 		(l, cleanup) <- liftIO $ lsTreeWithObjects r repo
-	(l', _, _) <- go h False [] topTree l
+		(l', _, _) <- go h False [] inTopTree l
-	sha <- liftIO $ mkTree h l'
+		l'' <- adjustlist h inTopTree (const True) l'
+		sha <- liftIO $ mkTree h l''
 		void $ liftIO cleanup
 		return sha
   where
 	go _ wasmodified c _ [] = return (c, wasmodified, [])
 	go h wasmodified c intree (i:is)
-		| intree i =
+		| intree i = case readObjectType (LsTree.typeobj i) of
-			case readObjectType (LsTree.typeobj i) of
 			Just BlobObject -> do
 				let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
-					v <- adjust ti
+				v <- adjusttreeitem ti
 				case v of
 					Nothing -> go h True c intree is
 					Just ti'@(TreeItem f m s) ->
@@ -136,31 +182,45 @@ adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do
 						    blob = TreeBlob f m s
 						in go h modified (blob:c) intree is
 			Just TreeObject -> do
-					(sl, modified, is') <- go h False [] (subTree i) is
+				(sl, modified, is') <- go h False [] (beneathSubTree i) is
-					subtree <- if modified
+				sl' <- adjustlist h (inTree i) (beneathSubTree i) sl
-						then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl
+				subtree <- if modified || sl' /= sl
+					then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl'
 					else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] 
 				let !modified' = modified || wasmodified
 				go h modified' (subtree : c) intree is'
 			_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
 		| otherwise = return (c, wasmodified, i:is)
 
+	adjustlist h ishere underhere l = do
+		let (addhere, rest) = partition ishere addtreeitems
+		let l' = filter (not . removed) $
+			map treeItemToTreeContent addhere ++ l
+		let inl i = any (\t -> beneathSubTree t i) l'
+		let (Tree addunderhere) = treeItemsToTree $
+			filter (\i -> underhere i && not (inl i)) rest
+		addunderhere' <- liftIO $ mapM (recordSubTree h) addunderhere
+		return (addunderhere'++l')
+
+	removeset = S.fromList removefiles
+	removed (TreeBlob f _ _) = S.member f removeset
+	removed _ = False
+
 {- Assumes the list is ordered, with tree objects coming right before their
  - contents. -}
 extractTree :: [LsTree.TreeItem] -> Either String Tree
-extractTree l = case go [] topTree l of
+extractTree l = case go [] inTopTree l of
 	Right (t, []) -> Right (Tree t)
 	Right _ -> parseerr "unexpected tree form"
 	Left e -> parseerr e
   where
 	go t _ [] = Right (t, [])
 	go t intree (i:is)
-		| intree i = 
+		| intree i = case readObjectType (LsTree.typeobj i) of
-			case readObjectType (LsTree.typeobj i) of
 			Just BlobObject ->
 				let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
 				in go (b:t) intree is
-				Just TreeObject -> case go [] (subTree i) is of
+			Just TreeObject -> case go [] (beneathSubTree i) is of
 				Right (subtree, is') ->
 					let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
 					in go (st:t) intree is'
@@ -169,12 +229,34 @@ extractTree l = case go [] topTree l of
 		| otherwise = Right (t, i:is)
 	parseerr = Left
 
-type InTree = LsTree.TreeItem -> Bool
+class GitPath t where
+	gitPath :: t -> FilePath
 
-topTree :: InTree
+instance GitPath FilePath where
-topTree = notElem '/' . getTopFilePath . LsTree.file
+	gitPath = id
 
-subTree :: LsTree.TreeItem -> InTree
+instance GitPath TopFilePath where
-subTree t =
+	gitPath = getTopFilePath
-	let prefix = getTopFilePath (LsTree.file t) ++ "/"
+
-	in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i))
+instance GitPath TreeItem where
+	gitPath (TreeItem f _ _) = gitPath f
+
+instance GitPath LsTree.TreeItem where
+	gitPath = gitPath . LsTree.file
+
+instance GitPath TreeContent where
+	gitPath (TreeBlob f _ _) = gitPath f
+	gitPath (RecordedSubTree f _ _) = gitPath f
+	gitPath (NewSubTree f _) = gitPath f
+
+inTopTree :: GitPath t => t -> Bool
+inTopTree = inTree "."
+
+inTree :: (GitPath t, GitPath f) => t -> f -> Bool
+inTree t f = gitPath t == takeDirectory (gitPath f)
+
+beneathSubTree :: (GitPath t, GitPath f) => t -> f -> Bool
+beneathSubTree t f = prefix `isPrefixOf` gitPath f
+  where
+	tp = gitPath t
+	prefix = if null tp then tp else tp ++ "/"

Git/Types.hs

@@ -105,6 +105,7 @@ fromBlobType SymlinkBlob = 0o120000
 
 data Commit = Commit
 	{ commitTree :: Sha
+	, commitParent :: [Sha]
 	, commitAuthorMetaData :: CommitMetaData
 	, commitCommitterMetaData :: CommitMetaData
 	, commitMessage :: String

debian/changelog

@@ -1,5 +1,9 @@
 git-annex (6.20160319) UNRELEASED; urgency=medium
 
+  * adjust --unlock: Enters an adjusted branch in which all annexed files
+    are unlocked. The v6 equivilant of direct mode, but much cleaner!
+  * init --version=6: Automatically enter the adjusted unlocked branch
+    when filesystem doesn't support symlinks.
   * ddar remote: fix ssh calls
     Thanks, Robie Basak
   * log: Display time with time zone.

doc/design/adjusted_branches.mdwn

@@ -62,12 +62,9 @@ it, so C does not remain in the adjusted branch history either. This will
 make other checkouts that are in the same adjusted branch end up with the
 same B' commit when they pull B.
 
-It might be useful to have a post-commit hook that generates B and B'
-and updates the branches. And/or `git-annex sync` could do it.
-
 There may be multiple commits made to the adjusted branch before any get
 applied back to the original branch. This is handled by reverse filtering
-one at a time and rebasing the others on top.
+commits one at a time and rebasing the others on top.
 
 	master           adjusted/master
 	A
@@ -112,10 +109,10 @@ beginning the merge. There may be staged changes, or changes in the work tree.
 
 First filter the new commit:
 
-	origin/master    adjusted/master
+	origin/master    adjusted/master      master
-	A
+	A                                     A
-	|--------------->A'
+	|--------------->A'                   |
-	|                |
+	|                |                    |
 	|                |
 	B
 	|                
@@ -123,10 +120,10 @@ First filter the new commit:
 
 Then, merge that into adjusted/master:
 
-	origin/master    adjusted/master
+	origin/master    adjusted/master     master
-	A
+	A                                    A
-	|--------------->A'
+	|--------------->A'                  |
-	|                |
+	|                |                   |
 	|                |
 	B                |
 	|                |
@@ -139,20 +136,30 @@ conflict should only affect the work tree/index, so can be resolved without
 making a commit, but B'' may end up being made to resolve a merge
 conflict.)
 
-Once the merge is done, we have a commit B'' on adjusted/master. To finish,
+Once the merge is done, we have a merge commit B'' on adjusted/master.
-adjust that commit so it does not have adjusted/master as its parent.
+To finish, redo that commit so it does not have A' as its parent.
 
-	origin/master    adjusted/master
+	origin/master    adjusted/master     master
-	A
+	A                                    A
-	|--------------->A'
+	|--------------->A'                  |
-	|                |
+	|                |                   |
 	|                |
 	B
 	|                
 	|--------------->B''
 	|                |
 
-Finally, update master to point to B''.
+Finally, update master, by reverse filtering B''.
+	
+	origin/master    adjusted/master    master
+	A                                   A
+	|--------------->A'                 |
+	|                |                  |
+	|                |                  |
+	B                                   |
+	|                                   |
+	|--------------->B'' - - - - - - -> B
+	|                |
 
 Notice how similar this is to the commit graph. So, "fast-forward" 
 merging the same B commit from origin/master will lead to an identical
@@ -172,48 +179,90 @@ between the adjusted work tree and pulled changes. A post-merge hook would
 be needed to re-adjust the work tree, and there would be a window where eg,
 not present files would appear in the work tree.]
 
+## another merge scenario
+
+Another merge scenario is when there's a new commit C on adjusted/master,
+and also a new commit B on origin/master.
+
+Start by adjusting B':
+
+	origin/master    adjusted/master      master
+	A                                     A
+	|--------------->A'                   |
+	|                |                    |
+	|                C'
+	B
+	|                
+	|---------->B'
+
+Then, merge B' into adjusted/master:
+
+	origin/master    adjusted/master     master
+	A                                    A
+	|--------------->A'                  |
+	|                |                   |
+	|                C'
+	B                |
+	|                |
+	|----------->B'->M'
+
+Here M' is the correct tree, but it has A' as its grandparent,
+which is the adjusted branch commit, so needs to be dropped in order to 
+get a commit that can be put on master.
+
+We don't want to lose commit C', but it's an adjusted
+commit, so needs to be de-adjusted.
+
+	origin/master    adjusted/master     master
+	A                                    A
+	|--------------->A'                  |
+	|                |                   |
+	|                C'- - - - - - - - > C
+	B                |
+	|                |
+	|----------->B'->M'
+	|               
+
+Now, we generate a merge commit, between B and C, with known result M'
+(so no actual merging done here).
+
+	origin/master    adjusted/master     master
+	A                                    A
+	|--------------->A'                  |
+	|                |                   |
+	|                C'- - - - - - - - > C
+	B                                    |
+	|                                    |
+	|--------------->M'<-----------------|
+	|               
+
+Finally, update master, by reverse filtering M'. The resulting commit
+on master will also be a merge between B and C.
+
 ## annex object add/remove
 
 When objects are added/removed from the annex, the associated file has to
 be looked up, and the filter applied to it. So, dropping a file with the
 missing file filter would cause it to be removed from the adjusted branch,
 and receiving a file's content would cause it to appear in the adjusted
-branch.
+branch. TODO
 
 These changes would need to be committed to the adjusted branch, otherwise
 `git diff` would show them.
 
 [WORKTREE: Simply adjust the work tree (and index) per the filter.]
 
-## reverse filtering
+## reverse filtering commits
 
-Reversing filter #1 would mean only converting pointer files to
+A user's commits on the adjusted branch have to be reverse filtered
-symlinks when the file was originally a symlink. This is problimatic when a
+to get changes to apply to the master branch.
-file is renamed. Would it be ok, if foo is renamed to bar and bar is
-committed, for it to be committed as an unlocked file, even if foo was
-originally locked? Probably.
 
-Reversing filter #2 would mean not deleting removed files whose content was
+This reversal of one filter can be done as just another filter.
-not present. When the commit includes deletion of files that were removed
+Since only files touched by the commit will be reverse filtered, it doesn't
-due to their content not being present, those deletions are not propigated.
+need to reverse all changes made by the original filter.
-When the user deletes an unlocked file, the content is still
-present in annex, so reversing the filter should propigate the file
-deletion. 
 
-What if an object was sent to the annex (or removed from the annex)
+For example, reversing the unlock filter might lock the file. Or, it might
-after the commit and before the reverse filtering? This would cause the
+do nothing, which would make all committed files remain unlocked.
-reverse filter to draw the wrong conclusion. Maybe look at a list of what
-objects were not present when applying the filter, and use that to decide
-which to not delete when reversing it?
-
-So, a reverse filter may need some state that was collected when running
-the filter forwards, in order to decide what to do.
-
-Alternatively, instead of reverse filtering the whole adjusted tree,
-look at just the new commit that's being propigated back from the
-adjusted to master branch. Get the diff from it to the previous
-commit; the changes that were made. Then de-adjust those changes,
-and apply the changes to the master branch.
 
 ## push
 
@@ -254,8 +303,15 @@ index in that case.
 
 Using `git checkout` when in an adjusted branch is problimatic, because a
 non-adjusted branch would then be checked out. But, we can just say, if
-you want to get into an adjusted branch, you have to run some command.
+you want to get into an adjusted branch, you have to run git annex adjust
-Or, could make a post-checkout hook.
+Or, could make a post-checkout hook. This is would mostly be confusing when
+git-annex init switched into the adjusted branch due to lack of symlink
+support.
+
+After a commit to an adjusted branch, `git push` won't do anything. The
+user has to know to git-annex sync. (Even if a pre-commit hook propigated
+the commit back to the master branch, `git push` wouldn't push it with the
+default "matching" push strategy.)
 
 Tags are bit of a problem. If the user tags an ajusted branch, the tag
 includes the local adjustments.  
@@ -282,47 +338,23 @@ adjusting filter, albeit an extreme one. This might improve view branches.
 For example, it's not currently possible to update a view branch with
 changes fetched from a remote, and this could get us there.
 
-This would need the reverse filter to be able to change metadata.
+This would need the reverse filter to be able to change metadata,
+so that a commit that moved files in the view updates their metadata.
 
 [WORKTREE: Wouldn't be able to integrate, unless view branches are changed
 into adjusted view worktrees.]
 
-## filter interface
+## TODOs
 
-Distilling all of the above, the filter interface needs to be something
+* Interface in webapp to enable adjustments.
-like this, at its most simple:
+* Upgrade from direct mode to v6 in unlocked branch.
-
+* Honor annex.thin when entering an adjusted branch.
-	data Filter = UnlockFilter | HideMissingFilter | UnlockHideMissingFilter
+* Cloning a repo that has an adjusted branch checked out gets into an ugly
-
+  state.
-	getFilter :: Annex Filter
+* There are potentially races in code that assumes a branch like
-
+  master is not being changed by someone else. In particular,
-	setFilter :: Filter -> Annex ()
+  propigateAdjustedCommits rebases the adjusted branch on top of master.
-
+  That is called by sync. The assumption is that any changes in master
-	data FilterAction
+  have already been handled by updateAdjustedBranch. But, if another remote
-		= UnchangedFile FilePath
+  pushed a new master at just the right time, the adjusted branch could be
-		| UnlockFile FilePath
+  rebased on top of a master that it doesn't incorporate, which is wrong.
-		| HideFile FilePath
-
-	data FileInfo = FileInfo
-		{ originalBranchFile :: FileStatus
-		, isContentPresent :: Bool
-		}
-
-	data FileStatus = IsAnnexSymlink | IsAnnexPointer
-		deriving (Eq)
-
-	filterAction :: Filter -> FilePath -> FileInfo -> FilterAction
-	filterAction UnlockFilter f fi
-		| originalBranchFile fi == IsAnnexSymlink = UnlockFile f
-	filterAction HideMissingFilter f fi
-		| not (isContentPresent fi) = HideFile f
-	filterAction UnlockHideMissingFilter f fi
-		| not (isContentPresent fi) = HideFile f
-		| otherwise = filterAction UnlockFilter f fi
-	filterAction _ f _ = UnchangedFile f
-
-	filteredCommit :: Filter -> Git.Commit -> Git.Commit
-
-	-- Generate a version of the commit made on the filter branch
-	-- with the filtering of modified files reversed.
-	unfilteredCommit :: Filter -> Git.Commit -> Git.Commit

doc/git-annex-adjust.mdwn

@@ -0,0 +1,50 @@
+# NAME
+
+git-annex adjust - enter an adjusted branch
+
+# SYNOPSIS
+
+git annex adjust --unlock`
+
+# DESCRIPTION
+
+Enters an adjusted form of the current branch. The annexed files will
+be treated differently. For example with --unlock all annexed files will
+be unlocked.
+
+The adjusted branch will have a name like "adjusted/master(unlocked)".
+Since it's a regular git branch, you can use `git checkout` to switch
+back to the original branch at any time.
+
+While in the adjusted branch, you can use git-annex and git commands as
+usual. Any commits that you make will initially only be made to the
+adjusted branch. 
+
+To propigate changes from the adjusted branch back to the original branch,
+and to other repositories, as well as to merge in changes from other
+repositories, use `git annex sync`.
+
+This command can only be used in a v6 git-annex repository.
+
+# OPTIONS
+
+* `--unlock`
+
+  Unlock all annexed files in the adjusted branch. This allows
+  annexed files to be modified.
+
+# SEE ALSO
+
+[[git-annex]](1)
+
+[[git-annex-unlock]](1)
+
+[[git-annex-upgrade]](1)
+
+[[git-annex-sync]](1)
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.

doc/git-annex-direct.mdwn

@@ -20,6 +20,8 @@ commands.
 Note that the direct mode/indirect mode distinction is removed in v6
 git-annex repositories. In such a repository, you can
 use [[git-annex-unlock]](1) to make a file's content be directly present.
+You can also use [[git-annex-adjust]](1) to enter a branch where all
+annexed files are unlocked, which is similar to the old direct mode.
 
 # SEE ALSO
 
@@ -29,6 +31,8 @@ use [[git-annex-unlock]](1) to make a file's content be directly present.
 
 [[git-annex-unlock]](1)
 
+[[git-annex-adjust]](1)
+
 # AUTHOR
 
 Joey Hess <id@joeyh.name>

doc/git-annex.mdwn

@@ -295,6 +295,13 @@ subdirectories).
   
   See [[git-annex-indirect]](1) for details.
 
+* `adjust`
+
+  Switches a repository to use an adjusted branch, which can automatically
+  unlock all files, etc.
+  
+  See [[git-annex-adjust]](1) for details.
+
 # REPOSITORY MAINTENANCE COMMANDS
 
 * `fsck [path ...]`

doc/tips/unlocked_files.mdwn

@@ -95,6 +95,8 @@ mode is used. To make them always use unlocked mode, run:
 `git config annex.addunlocked true`
 """]]
 
+## mixing locked and unlocked files
+
 A v6 repository can contain both locked and unlocked files. You can switch 
 a file back and forth using the `git annex lock` and `git annex unlock`
 commands. This changes what's stored in git between a git-annex symlink
@@ -102,6 +104,12 @@ commands. This changes what's stored in git between a git-annex symlink
 the repository in locked mode, use `git annex add`; to add a file in
 unlocked mode, use `git add`.
 
+If you want to mostly keep files locked, but be able to locally switch
+to having them all unlocked, you can do so using `git annex adjust
+--unlock`. See [[git-annex-adjust]] for details. This is particularly
+useful when using filesystems like FAT, and OS's like Windows that don't
+support symlinks.
+
 ## using less disk space
 
 Unlocked files are handy, but they have one significant disadvantage

doc/todo/smudge.mdwn

@@ -23,12 +23,6 @@ git-annex should use smudge/clean filters.
   (May need to use libgit2 to do this efficiently, cannot find
   any plumbing except git-update-index, which is very inneficient for
   smudged files.)
-* Crippled filesystem should cause all files to be transparently unlocked.
-  Note that this presents problems when dealing with merge conflicts and
-  when pushing changes committed in such a repo. Ideally, should avoid
-  committing implicit unlocks, or should prevent such commits leaking out
-  in pushes. See [[design/adjusted_branches]].
-
 * Eventually (but not yet), make v6 the default for new repositories.
   Note that the assistant forces repos into direct mode; that will need to
   be changed then, and it should enable annex.thin instead.