add vadd command

5 files changed, 53 insertions, 9 deletions

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 49d34e17f..2bbab6eb0 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -28,6 +28,7 @@ import qualified Command.TransferKeys
 import qualified Command.ReKey
 import qualified Command.MetaData
 import qualified Command.View
+import qualified Command.VAdd
 import qualified Command.VPop
 import qualified Command.Reinject
 import qualified Command.Fix
@@ -139,6 +140,7 @@ cmds = concat
 	, Command.ReKey.def
 	, Command.MetaData.def
 	, Command.View.def
+	, Command.VAdd.def
 	, Command.VPop.def
 	, Command.Fix.def
 	, Command.Fsck.def
diff --git a/Command/VAdd.hs b/Command/VAdd.hs
new file mode 100644
index 000000000..a79e91215
--- /dev/null
+++ b/Command/VAdd.hs
@@ -0,0 +1,47 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.VAdd where
+
+import Common.Annex
+import Command
+import Types.View
+import Annex.View
+import Logs.View
+import Command.View (paramView, parseViewParam, checkoutViewBranch)
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+	command "vadd" paramView seek SectionUtility "refine current view"]
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start params = do
+	showStart "vadd" ""
+	go =<< currentView
+  where
+	go Nothing = error "Not in a view."
+	go (Just view) = do
+		let (view', change) = calc view Unchanged (reverse params)
+		case change of
+			Unchanged -> do
+				showNote "unchanged"
+				next $ next $ return True
+			Widening -> error "Widening view to match more files is not currently supported."
+			Narrowing -> next $ perform view'
+
+	calc v c [] = (v, c)
+	calc v c (p:ps) =
+		let (v', c') = uncurry (refineView v) (parseViewParam p)
+		in calc v' (max c c') ps
+
+perform :: View -> CommandPerform
+perform view = do
+	branch <- narrowView view
+	next $ checkoutViewBranch view branch
diff --git a/Command/View.hs b/Command/View.hs
index 309a1ccbe..4e642e50f 100644
--- a/Command/View.hs
+++ b/Command/View.hs
@@ -39,7 +39,7 @@ start params = do
 
 perform :: View -> CommandPerform
 perform view = do
-	showSideAction "calculating"
+	showSideAction "searching"
 	branch <- applyView view
 	next $ checkoutViewBranch view branch
 
diff --git a/debian/changelog b/debian/changelog
index dd28c5c9b..167d026cc 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -7,7 +7,7 @@ git-annex (5.20140211) UNRELEASED; urgency=medium
     to limit them to acting on files that have particular metadata.
   * view: New command that creates and checks out a branch that provides
     a structured view of selected metadata.
-  * vadd, vrm, vpop: New commands for operating within views.
+  * vadd, vpop: New commands for operating within views.
   * Add progress display for transfers to/from external special remotes.
   * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes
   * Windows webapp: Can create repos on removable drives.
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 84cb55a43..b96cedbfe 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -328,13 +328,8 @@ subdirectories).
 
 * `vadd [field=value ...] [tag ...]`
 
-  Can be used when already in a view to add additional fields or tags
-  to the view.
-
-* `vrm [field=value ...] [tag ...]`
-
-  Can be used when already in a view to remove fields or tags from the
-  view.
+  Refines the currently checked out view branch, adding additional fields
+  or tags.
 
 * `vpop`