Merge branch 'undo'
This commit is contained in:
commit
ffac19a29c
9 changed files with 161 additions and 13 deletions
|
@ -92,18 +92,20 @@ installWrapper file content = do
|
|||
installFileManagerHooks :: FilePath -> IO ()
|
||||
#ifdef linux_HOST_OS
|
||||
installFileManagerHooks program = do
|
||||
let actions = ["get", "drop", "undo"]
|
||||
|
||||
-- Gnome
|
||||
nautilusScriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir
|
||||
createDirectoryIfMissing True nautilusScriptdir
|
||||
genNautilusScript nautilusScriptdir "get"
|
||||
genNautilusScript nautilusScriptdir "drop"
|
||||
forM_ actions $
|
||||
genNautilusScript nautilusScriptdir
|
||||
|
||||
-- KDE
|
||||
home <- myHomeDir
|
||||
let kdeServiceMenusdir = home </> ".kde" </> "share" </> "kde4" </> "services" </> "ServiceMenus"
|
||||
createDirectoryIfMissing True kdeServiceMenusdir
|
||||
writeFile (kdeServiceMenusdir </> "git-annex.desktop")
|
||||
(kdeDesktopFile ["get", "drop"])
|
||||
(kdeDesktopFile actions)
|
||||
where
|
||||
genNautilusScript scriptdir action =
|
||||
installscript (scriptdir </> scriptname action) $ unlines
|
||||
|
|
|
@ -84,6 +84,7 @@ import qualified Command.Indirect
|
|||
import qualified Command.Upgrade
|
||||
import qualified Command.Forget
|
||||
import qualified Command.Proxy
|
||||
import qualified Command.Undo
|
||||
import qualified Command.Version
|
||||
import qualified Command.Help
|
||||
#ifdef WITH_ASSISTANT
|
||||
|
@ -177,6 +178,7 @@ cmds = concat
|
|||
, Command.Upgrade.cmd
|
||||
, Command.Forget.cmd
|
||||
, Command.Proxy.cmd
|
||||
, Command.Undo.cmd
|
||||
, Command.Version.cmd
|
||||
, Command.Help.cmd
|
||||
#ifdef WITH_ASSISTANT
|
||||
|
|
84
Command/Undo.hs
Normal file
84
Command/Undo.hs
Normal file
|
@ -0,0 +1,84 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.Undo where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Config
|
||||
import Annex.Direct
|
||||
import Annex.CatFile
|
||||
import Git.DiffTree
|
||||
import Git.FilePath
|
||||
import Git.UpdateIndex
|
||||
import Git.Sha
|
||||
import qualified Git.LsFiles as LsFiles
|
||||
import qualified Git.Command as Git
|
||||
import qualified Git.Branch
|
||||
import qualified Command.Sync
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [notBareRepo $
|
||||
command "undo" paramPaths seek
|
||||
SectionCommon "undo last change to a file or directory"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek ps = do
|
||||
-- Safety first; avoid any undo that would touch files that are not
|
||||
-- in the index.
|
||||
(fs, cleanup) <- inRepo $ LsFiles.notInRepo False ps
|
||||
unless (null fs) $
|
||||
error $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
|
||||
void $ liftIO $ cleanup
|
||||
|
||||
-- Committing staged changes before undo allows later
|
||||
-- undoing the undo. It would be nicer to only commit staged
|
||||
-- changes to the specified files, rather than all staged changes,
|
||||
-- but that is difficult to do; a partial git-commit can't be done
|
||||
-- in direct mode.
|
||||
void $ Command.Sync.commitStaged Git.Branch.ManualCommit
|
||||
"commit before undo"
|
||||
|
||||
withStrings start ps
|
||||
|
||||
start :: FilePath -> CommandStart
|
||||
start p = do
|
||||
showStart "undo" p
|
||||
next $ perform p
|
||||
|
||||
perform :: FilePath -> CommandPerform
|
||||
perform p = do
|
||||
g <- gitRepo
|
||||
|
||||
-- Get the reversed diff that needs to be applied to undo.
|
||||
(diff, cleanup) <- inRepo $
|
||||
diffLog [Param "-R", Param "--", Param p]
|
||||
top <- inRepo $ toTopFilePath p
|
||||
let diff' = filter (`isDiffOf` top) diff
|
||||
liftIO $ streamUpdateIndex g (map stageDiffTreeItem diff')
|
||||
|
||||
-- Take two passes through the diff, first doing any removals,
|
||||
-- and then any adds. This order is necessary to handle eg, removing
|
||||
-- a directory and replacing it with a file.
|
||||
let (removals, adds) = partition (\di -> dstsha di == nullSha) diff'
|
||||
let mkrel di = liftIO $ relPathCwdToFile $ fromTopFilePath (file di) g
|
||||
|
||||
forM_ removals $ \di -> do
|
||||
f <- mkrel di
|
||||
whenM isDirect $
|
||||
maybe noop (`removeDirect` f)
|
||||
=<< catKey (srcsha di) (srcmode di)
|
||||
liftIO $ nukeFile f
|
||||
|
||||
forM_ adds $ \di -> do
|
||||
f <- mkrel di
|
||||
inRepo $ Git.run [Param "checkout", Param "--", File f]
|
||||
whenM isDirect $
|
||||
maybe noop (`toDirect` f)
|
||||
=<< catKey (dstsha di) (dstmode di)
|
||||
|
||||
next $ liftIO cleanup
|
|
@ -7,10 +7,12 @@
|
|||
|
||||
module Git.DiffTree (
|
||||
DiffTreeItem(..),
|
||||
isDiffOf,
|
||||
diffTree,
|
||||
diffTreeRecursive,
|
||||
diffIndex,
|
||||
diffWorkTree,
|
||||
diffLog,
|
||||
) where
|
||||
|
||||
import Numeric
|
||||
|
@ -33,6 +35,13 @@ data DiffTreeItem = DiffTreeItem
|
|||
, file :: TopFilePath
|
||||
} deriving Show
|
||||
|
||||
{- Checks if the DiffTreeItem modifies a file with a given name
|
||||
- or under a directory by that name. -}
|
||||
isDiffOf :: DiffTreeItem -> TopFilePath -> Bool
|
||||
isDiffOf diff f = case getTopFilePath f of
|
||||
"" -> True -- top of repo contains all
|
||||
d -> d `dirContains` getTopFilePath (file diff)
|
||||
|
||||
{- Diffs two tree Refs. -}
|
||||
diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)
|
||||
diffTree src dst = getdiff (Param "diff-tree")
|
||||
|
@ -66,16 +75,23 @@ diffIndex' ref params repo =
|
|||
, return ([], return True)
|
||||
)
|
||||
|
||||
{- 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
|
||||
- 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)
|
||||
|
||||
getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
|
||||
getdiff command params repo = do
|
||||
(diff, cleanup) <- pipeNullSplit ps repo
|
||||
return (parseDiffTree diff, cleanup)
|
||||
return (parseDiffRaw diff, cleanup)
|
||||
where
|
||||
ps = command : Params "-z --raw --no-renames -l0" : params
|
||||
|
||||
{- Parses diff-tree output. -}
|
||||
parseDiffTree :: [String] -> [DiffTreeItem]
|
||||
parseDiffTree l = go l []
|
||||
{- Parses --raw output used by diff-tree and git-log. -}
|
||||
parseDiffRaw :: [String] -> [DiffTreeItem]
|
||||
parseDiffRaw l = go l []
|
||||
where
|
||||
go [] c = c
|
||||
go (info:f:rest) c = go rest (mk info f : c)
|
||||
|
|
|
@ -19,7 +19,8 @@ module Git.UpdateIndex (
|
|||
updateIndexLine,
|
||||
stageFile,
|
||||
unstageFile,
|
||||
stageSymlink
|
||||
stageSymlink,
|
||||
stageDiffTreeItem,
|
||||
) where
|
||||
|
||||
import Common
|
||||
|
@ -28,6 +29,7 @@ import Git.Types
|
|||
import Git.Command
|
||||
import Git.FilePath
|
||||
import Git.Sha
|
||||
import qualified Git.DiffTree as Diff
|
||||
|
||||
{- Streamers are passed a callback and should feed it lines in the form
|
||||
- read by update-index, and generated by ls-tree. -}
|
||||
|
@ -95,7 +97,10 @@ stageFile sha filetype file repo = do
|
|||
unstageFile :: FilePath -> Repo -> IO Streamer
|
||||
unstageFile file repo = do
|
||||
p <- toTopFilePath file repo
|
||||
return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
|
||||
return $ unstageFile' p
|
||||
|
||||
unstageFile' :: TopFilePath -> Streamer
|
||||
unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
|
||||
|
||||
{- A streamer that adds a symlink to the index. -}
|
||||
stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
|
||||
|
@ -106,5 +111,11 @@ stageSymlink file sha repo = do
|
|||
<*> toTopFilePath file repo
|
||||
return $ pureStreamer line
|
||||
|
||||
{- A streamer that applies a DiffTreeItem to the index. -}
|
||||
stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer
|
||||
stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of
|
||||
Nothing -> unstageFile' (Diff.file d)
|
||||
Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d)
|
||||
|
||||
indexPath :: TopFilePath -> InternalGitPath
|
||||
indexPath = toInternalGitPath . getTopFilePath
|
||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -6,6 +6,9 @@ git-annex (5.20141126) UNRELEASED; urgency=medium
|
|||
* proxy: New command for direct mode repositories, allows bypassing
|
||||
the direct mode guard in a safe way to do all sorts of things
|
||||
including git revert, git mv, git checkout ...
|
||||
* undo: New command to undo the most recent change to a file
|
||||
or to the contents of a directory.
|
||||
* Add undo action to nautilus and konqueror integration.
|
||||
* Work around behavior change in lsof 4.88's -F output format.
|
||||
* Debian package is now maintained by Gergely Nagy.
|
||||
* Windows: Remove Alt+A keyboard shortcut, which turns out to have scope
|
||||
|
|
|
@ -282,6 +282,22 @@ subdirectories).
|
|||
are on a video hosting site, and the video is downloaded. This allows
|
||||
importing e.g., youtube playlists.
|
||||
|
||||
* `undo [filename|directory] ...`
|
||||
|
||||
When passed a filename, undoes the last change that was made to that
|
||||
file.
|
||||
|
||||
When passed a directory, undoes the last change that was made to the
|
||||
contents of that directory.
|
||||
|
||||
Running undo a second time will undo the undo, returning the working
|
||||
tree to the same state it had before. In order for undoing an undo of
|
||||
staged changes, any staged changes are first committed by the
|
||||
undo command.
|
||||
|
||||
Note that this does not undo get/drop of a file's content; it only
|
||||
operates on the file tree committed to git.
|
||||
|
||||
* `watch`
|
||||
|
||||
Watches for changes to files in the current directory and its subdirectories,
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
Integrating git-annex and your file manager provides an easy way to select
|
||||
annexed files to get or drop.
|
||||
annexed files to get or drop. The file manager can also be used to undo
|
||||
changes to file managed by git-annex.
|
||||
|
||||
[[!toc]]
|
||||
|
||||
|
@ -25,13 +26,20 @@ This is set up by git-annex creating a
|
|||
|
||||
## XFCE (Thunar)
|
||||
|
||||
XFCE uses the Thunar file manager, which can also be easily configured to allow for custom actions. Just go to the "Configure custom actions..." item in the "Edit" menu, and create a custom action for get and drop with the following commands:
|
||||
XFCE uses the Thunar file manager, which can also be easily configured to
|
||||
allow for custom actions. Just go to the "Configure custom actions..." item
|
||||
in the "Edit" menu, and create a custom action for get, drop, and undo with the
|
||||
following commands:
|
||||
|
||||
git-annex drop --notify-start --notify-finish -- %F
|
||||
|
||||
for drop, and for get:
|
||||
|
||||
git-annex get --notify-start --notify-finish -- %F
|
||||
|
||||
and for undo:
|
||||
|
||||
git-annex undo --notify-start --notify-finish -- %F
|
||||
|
||||
This gives me the resulting config on disk, in `.config/Thunar/uca.xml`:
|
||||
|
||||
|
@ -68,7 +76,9 @@ The complete instructions on how to setup actions is [in the XFCE documentation]
|
|||
|
||||
## OS X (Finder)
|
||||
|
||||
For OS X, it is possible to get context menus in Finder. Due to how OS X deals with sym links, one needs to operate on folders if using indirect mode. Direct mode operation has not been tested.
|
||||
For OS X, it is possible to get context menus in Finder. Due to how OS X
|
||||
deals with sym links, one needs to operate on folders if using indirect
|
||||
mode. Direct mode operation has not been tested.
|
||||
|
||||
1. Open Automator and create a new Service.
|
||||
2. Using the Drop down menus in the top create the sentence "Service receives selected folders in Finder.app" to have it work on folders. For direct mode operation it is probably reasonable to select "files or folders".
|
||||
|
@ -81,7 +91,9 @@ For OS X, it is possible to get context menus in Finder. Due to how OS X deals w
|
|||
cd "$(dirname "$f")" && git-annex get "$f"
|
||||
done
|
||||
|
||||
The purpose of the first line is there to get git-annex on to the path. The reason for the for loop is in case multiple files or folders are marked when running the context menu command.
|
||||
The purpose of the first line is there to get git-annex on to the path. The
|
||||
reason for the for loop is in case multiple files or folders are marked
|
||||
when running the context menu command.
|
||||
|
||||
Finally save the the workflow under the name for which it should be listed in the context menu.
|
||||
|
||||
|
|
|
@ -80,5 +80,7 @@ the last change to each file would be expensive, and likely confusing.
|
|||
Instead, when a directory is passed, it could find the most recent commit
|
||||
that touched files in that directory, and undo the changes to those files.
|
||||
|
||||
> [[done]] --[[Joey]]
|
||||
|
||||
Also, --depth could make undo look for an older commit than the most
|
||||
recent one to affect the specified file.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue