module Yi.Dired
( dired
, diredDir
, diredDirBuffer
) where
import qualified Codec.Binary.UTF8.String as UTF8
import Control.Monad.Reader hiding (mapM)
import Control.Lens hiding (act, op, pre)
import Data.Binary
import Data.List hiding (find, maximum, concat)
import Data.Char (toLower)
import Data.DeriveTH
import Data.Default
import Data.Typeable
import Data.Maybe
import Data.Foldable (find)
import qualified Data.Map as M
import qualified Data.Rope as R
import Data.Time
import Data.Time.Clock.POSIX
import System.Directory hiding (canonicalizePath)
import System.FilePath
import System.CanonicalizePath (canonicalizePath)
import System.Locale
import System.PosixCompat.Files
import System.PosixCompat.Types
import System.PosixCompat.User
import Control.Exc
import Text.Printf
import Yi.Core
import Yi.File (editFile)
import Yi.MiniBuffer (spawnMinibufferE, withMinibufferGen, noHint, withMinibuffer)
import Yi.Misc (getFolder, promptFile)
import Yi.Style
import Yi.Utils
import Yi.Monad
data DiredFileInfo = DiredFileInfo { permString :: String
, numLinks :: Integer
, owner :: String
, grp :: String
, sizeInBytes :: Integer
, modificationTimeString :: String
}
deriving (Show, Eq, Typeable)
data DiredEntry = DiredFile DiredFileInfo
| DiredDir DiredFileInfo
| DiredSymLink DiredFileInfo String
| DiredSocket DiredFileInfo
| DiredBlockDevice DiredFileInfo
| DiredCharacterDevice DiredFileInfo
| DiredNamedPipe DiredFileInfo
| DiredNoInfo
deriving (Show, Eq, Typeable)
data DiredState = DiredState
{ diredPath :: FilePath
, diredMarks :: M.Map FilePath Char
, diredEntries :: M.Map FilePath DiredEntry
, diredFilePoints :: [(Point,Point,FilePath)]
, diredNameCol :: Int
, diredCurrFile :: FilePath
}
deriving (Show, Eq, Typeable)
$(derive makeBinary ''DiredState)
instance Default DiredState where
def = DiredState { diredPath = ""
, diredMarks = M.empty
, diredEntries = M.empty
, diredFilePoints = []
, diredNameCol = 0
, diredCurrFile = ""
}
instance YiVariable DiredState
$(derives [makeBinary] [''DiredEntry, ''DiredFileInfo])
bypassReadOnly :: BufferM a -> BufferM a
bypassReadOnly f = do ro <- use readOnlyA
assign readOnlyA False
res <- f
assign readOnlyA ro
return res
filenameColOf :: BufferM () -> BufferM ()
filenameColOf f = use bufferDynamicValueA >>= setPrefCol . Just . diredNameCol >> f
resetDiredOpState :: YiM ()
resetDiredOpState = withBuffer $ (%=) bufferDynamicValueA (\_ds -> def :: DiredOpState)
incDiredOpSucCnt :: YiM ()
incDiredOpSucCnt = withBuffer $ (%=) bufferDynamicValueA (\ds -> ds { diredOpSucCnt = diredOpSucCnt ds + 1 })
getDiredOpState :: YiM DiredOpState
getDiredOpState = withBuffer $ use bufferDynamicValueA
modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM ()
modDiredOpState f = withBuffer $ (%=) bufferDynamicValueA f
procDiredOp :: Bool -> [DiredOp] -> YiM ()
procDiredOp counting (DORemoveFile f:ops) = do
io $ printingException ("Remove file " ++ f) (removeLink f)
when counting postproc
procDiredOp counting ops
where postproc = do incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName f)
procDiredOp counting (DORemoveDir f:ops) = do
io $ printingException ("Remove directory " ++ f) (removeDirectoryRecursive f)
when counting postproc
procDiredOp counting ops
where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName f)
procDiredOp _counting (DORemoveBuffer _:_) = undefined
procDiredOp counting (DOCopyFile o n:ops) = do
io $ printingException ("Copy file " ++ o) (copyFile o n)
when counting postproc
procDiredOp counting ops
where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName o)
procDiredOp counting (DOCopyDir o n:ops) = do
contents <- io $ printingException (concat ["Copy directory ", o, " to ", n]) doCopy
subops <- io $ mapM builder $ filter (`notElem` [".", ".."]) contents
procDiredOp False subops
when counting postproc
procDiredOp counting ops
where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName o)
doCopy :: IO [FilePath]
doCopy = do
exists <- doesDirectoryExist n
when exists $ removeDirectoryRecursive n
createDirectoryIfMissing True n
getDirectoryContents o
builder :: FilePath -> IO DiredOp
builder name = do
let npath = n </> name
let opath = o </> name
isDir <- doesDirectoryExist opath
return $ DOCkOverwrite npath $ getOp isDir opath npath
where getOp isDir = if isDir then DOCopyDir else DOCopyFile
procDiredOp counting (DORename o n:ops) = do
io $ printingException (concat ["Rename ", o, " to ", n]) (rename o n)
when counting postproc
procDiredOp counting ops
where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName o)
procDiredOp counting r@(DOConfirm prompt eops enops:ops) =
withMinibuffer (prompt ++ " (yes/no)") noHint act
where act s = case map toLower s of
"yes" -> procDiredOp counting (eops ++ ops)
"no" -> procDiredOp counting (enops ++ ops)
_ -> procDiredOp counting r
procDiredOp counting (DOCheck check eops enops:ops) = do
res <- io check
procDiredOp counting (if res then eops ++ ops else enops ++ ops)
procDiredOp counting (DOCkOverwrite fp op:ops) = do
exists <- io $ fileExist fp
procDiredOp counting (if exists then newOp:ops else op:ops)
where newOp = DOChoice (concat ["Overwrite ", fp, " ?"]) op
procDiredOp counting (DOInput prompt opGen:ops) =
promptFile prompt act
where act s = procDiredOp counting $ opGen s ++ ops
procDiredOp counting (DONoOp:ops) = procDiredOp counting ops
procDiredOp counting (DOFeedback f:ops) =
getDiredOpState >>= f >> procDiredOp counting ops
procDiredOp counting r@(DOChoice prompt op:ops) = do
st <- getDiredOpState
if diredOpForAll st then proceedYes
else void $ withEditor $ spawnMinibufferE msg (const askKeymap)
where msg = prompt ++ " (y/n/!/q/h)"
askKeymap = choice [ char 'n' ?>>! noAction
, char 'y' ?>>! yesAction
, char '!' ?>>! allAction
, char 'q' ?>>! quit
, char 'h' ?>>! help
]
noAction = cleanUp >> proceedNo
yesAction = cleanUp >> proceedYes
allAction = do cleanUp
modDiredOpState (\st -> st{diredOpForAll=True})
proceedYes
quit = cleanUp >> msgEditor "Quit"
help = do msgEditor $ concat ["y: yes, n: no, ",
"!: yes on all remaining items, ",
"q: quit, h: help"]
cleanUp
procDiredOp counting r
cleanUp = withEditor closeBufferAndWindowE
proceedYes = procDiredOp counting (op:ops)
proceedNo = procDiredOp counting ops
procDiredOp _ _ = return ()
askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askDelFiles dir fs =
case fs of
(_x:_) -> do
resetDiredOpState
opList <- io $ sequence ops
procDiredOp True [DOConfirm prompt (opList ++ [DOFeedback showResult]) [DOFeedback showNothing]]
[] -> procDiredOp True [DOFeedback showNothing]
where prompt = concat ["Delete ", show $ length fs, " file(s)?"]
ops = map opGenerator fs
showResult st = do
diredRefresh
msgEditor $ concat [show $ diredOpSucCnt st, " of ",
show total, " deletions done"]
showNothing _ = msgEditor "(No deletions requested)"
total = length fs
opGenerator :: (FilePath, DiredEntry) -> IO DiredOp
opGenerator (fn, de) = do
exists <- fileExist path
if exists then case de of
(DiredDir _dfi) -> do
isNull <- liftM nullDir $ getDirectoryContents path
return $ if isNull then DOConfirm recDelPrompt [DORemoveDir path] [DONoOp]
else DORemoveDir path
_ -> return (DORemoveFile path)
else return DONoOp
where path = dir </> fn
recDelPrompt = concat ["Recursive delete of ", fn, "?"]
nullDir :: [FilePath] -> Bool
nullDir = Data.List.any (not . flip Data.List.elem [".", ".."])
diredDoDel :: YiM ()
diredDoDel = do
dir <- currentDir
maybefile <- withBuffer fileFromPoint
case maybefile of
Just (fn, de) -> askDelFiles dir [(fn, de)]
Nothing -> noFileAtThisLine
diredDoMarkedDel :: YiM ()
diredDoMarkedDel = do
dir <- currentDir
fs <- markedFiles (`Data.List.elem` ['D'])
askDelFiles dir fs
diredKeymap :: Keymap -> Keymap
diredKeymap =
(choice [
char 'p' ?>>! filenameColOf lineUp,
oneOf [char 'n', char ' '] >>! filenameColOf lineDown,
char 'd' ?>>! diredMarkDel,
char 'g' ?>>! diredRefresh,
char 'm' ?>>! diredMark,
char '^' ?>>! diredUpDir,
char '+' ?>>! diredCreateDir,
char 'q' ?>>! (deleteBuffer =<< gets currentBuffer),
char 'x' ?>>! diredDoMarkedDel,
oneOf [ctrl $ char 'm', spec KEnter, char 'f'] >>! diredLoad,
oneOf [char 'u', spec KBS] >>! diredUnmark,
char 'D' ?>>! diredDoDel,
char 'U' ?>>! diredUnmarkAll,
char 'R' ?>>! diredRename,
char 'C' ?>>! diredCopy]
<||)
dired :: YiM ()
dired = do
msgEditor "Dired..."
maybepath <- withBuffer $ gets file
dir <- io $ getFolder maybepath
void $ editFile dir
diredDir :: FilePath -> YiM ()
diredDir dir = void (diredDirBuffer dir)
diredDirBuffer :: FilePath -> YiM BufferRef
diredDirBuffer d = do
dir <- io $ canonicalizePath d
b <- withEditor $ stringToNewBuffer (Left dir) (R.fromString "")
withEditor $ switchToBufferE b
withBuffer $ (%=) bufferDynamicValueA $ \ds -> ds { diredPath = dir }
diredRefresh
return b
diredRefresh :: YiM ()
diredRefresh = do
dState <- withBuffer $ use bufferDynamicValueA
let dir = diredPath dState
di <- io $ diredScanDir dir
currFile <- if null (diredFilePoints dState)
then return ""
else do maybefile <- withBuffer fileFromPoint
case maybefile of
Just (fp, _) -> return fp
Nothing -> return ""
let ds = dState {diredEntries = di, diredCurrFile = currFile}
let dlines = linesToDisplay ds
(strss, stys, strs) = unzip3 dlines
strss' = transpose $ map doPadding $ transpose strss
namecol = if null strss' then 0 else
let l1details = init $ head strss' in Data.List.sum (map length l1details) + length l1details
withBuffer $ do
assign readOnlyA False
deleteRegionB =<< regionOfB Document
insertN $ dir ++ ":\n"
p <-pointB
addOverlayB $ mkOverlay UserLayer (mkRegion 0 (p2)) headStyle
ptsList <- mapM insertDiredLine $ zip3 strss' stys strs
assign bufferDynamicValueA ds{diredFilePoints=ptsList,
diredNameCol =namecol}
modifyMode $ \m -> m {modeKeymap = topKeymapA %~ diredKeymap, modeName = "dired"}
diredRefreshMark
assign readOnlyA True
when (null currFile) $ moveTo (p2)
case getRow currFile ptsList of
Just rpos -> filenameColOf $ moveTo rpos
Nothing -> filenameColOf lineDown
where
getRow fp recList = lookup fp (map (\(a,_b,c)->(c,a)) recList)
headStyle = const (withFg grey)
doPadding :: [DRStrings] -> [String]
doPadding drs = map (pad ((maximum . map drlength) drs)) drs
pad _n (DRPerms s) = s
pad n (DRLinks s) = replicate (max 0 (n length s)) ' ' ++ s
pad n (DROwners s) = s ++ replicate (max 0 (n length s)) ' ' ++ " "
pad n (DRGroups s) = s ++ replicate (max 0 (n length s)) ' '
pad n (DRSizes s) = replicate (max 0 (n length s)) ' ' ++ s
pad n (DRDates s) = replicate (max 0 (n length s)) ' ' ++ s
pad _n (DRFiles s) = s
drlength = length . undrs
insertDiredLine :: ([String], StyleName, String) -> BufferM (Point, Point, FilePath)
insertDiredLine (fields, sty, filenm) = bypassReadOnly $ do
insertN (unwords (init fields))
p1 <- pointB
insertN (' ' : last fields)
p2 <- pointB
insertN "\n"
addOverlayB (mkOverlay UserLayer (mkRegion p1 p2) sty)
return (p1, p2, filenm)
data DRStrings = DRPerms {undrs :: String}
| DRLinks {undrs :: String}
| DROwners {undrs :: String}
| DRGroups {undrs :: String}
| DRSizes {undrs :: String}
| DRDates {undrs :: String}
| DRFiles {undrs :: String}
linesToDisplay :: DiredState -> [([DRStrings], StyleName, String)]
linesToDisplay dState = map (\(k, i) -> let k' = UTF8.decodeString k in lineToDisplay k' i) (M.assocs $ diredEntries dState)
where
lineToDisplay k (DiredFile v) = (l " -" v ++ [DRFiles k], defaultStyle, k)
lineToDisplay k (DiredDir v) = (l " d" v ++ [DRFiles k], const (withFg blue), k)
lineToDisplay k (DiredSymLink v s) = (l " l" v ++ [DRFiles $ k ++ " -> " ++ s], const (withFg cyan), k)
lineToDisplay k (DiredSocket v) = (l " s" v ++ [DRFiles k], const (withFg magenta), k)
lineToDisplay k (DiredCharacterDevice v) = (l " c" v ++ [DRFiles k], const (withFg yellow), k)
lineToDisplay k (DiredBlockDevice v) = (l " b" v ++ [DRFiles k], const (withFg yellow), k)
lineToDisplay k (DiredNamedPipe v) = (l " p" v ++ [DRFiles k], const (withFg brown), k)
lineToDisplay k DiredNoInfo = ([DRFiles $ k ++ " : Not a file/dir/symlink"], defaultStyle, k)
l pre v = [DRPerms $ pre ++ permString v,
DRLinks $ printf "%4d" (numLinks v),
DROwners $ owner v,
DRGroups $ grp v,
DRSizes $ printf "%8d" (sizeInBytes v),
DRDates $ modificationTimeString v]
diredScanDir :: FilePath -> IO (M.Map FilePath DiredEntry)
diredScanDir dir = do
files <- getDirectoryContents dir
foldM (lineForFile dir) M.empty files
where
lineForFile :: String -> M.Map FilePath DiredEntry -> String -> IO (M.Map FilePath DiredEntry)
lineForFile d m f = do
let fp = d </> f
fileStatus <- getSymbolicLinkStatus fp
dfi <- lineForFilePath fp fileStatus
let islink = isSymbolicLink fileStatus
linkTarget <- if islink then readSymbolicLink fp else return ""
let de
| isDirectory fileStatus = DiredDir dfi
| isRegularFile fileStatus = DiredFile dfi
| islink = DiredSymLink dfi linkTarget
| isSocket fileStatus = DiredSocket dfi
| isCharacterDevice fileStatus = DiredCharacterDevice dfi
| isBlockDevice fileStatus = DiredBlockDevice dfi
| isNamedPipe fileStatus = DiredNamedPipe dfi
| otherwise = DiredNoInfo
return (M.insert f de m)
lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo
lineForFilePath fp fileStatus = do
let modTimeStr = shortCalendarTimeToString $ posixSecondsToUTCTime $ realToFrac $ modificationTime fileStatus
let uid = fileOwner fileStatus
gid = fileGroup fileStatus
_filenm <- if isSymbolicLink fileStatus then
return . ((takeFileName fp ++ " -> ") ++) =<< readSymbolicLink fp else
return $ takeFileName fp
ownerEntry <- orException (getUserEntryForID uid) (liftM (scanForUid uid) getAllUserEntries)
groupEntry <- orException (getGroupEntryForID gid) (liftM (scanForGid gid) getAllGroupEntries)
let fmodeStr = (modeString . fileMode) fileStatus
sz = toInteger $ fileSize fileStatus
ownerStr = userName ownerEntry
groupStr = groupName groupEntry
numOfLinks = toInteger $ linkCount fileStatus
return DiredFileInfo { permString = fmodeStr
, numLinks = numOfLinks
, owner = ownerStr
, grp = groupStr
, sizeInBytes = sz
, modificationTimeString = modTimeStr}
scanForUid :: UserID -> [UserEntry] -> UserEntry
scanForUid uid entries = fromMaybe (UserEntry "?" "" uid 0 "" "" "") (find ((== uid) . userID) entries)
scanForGid :: GroupID -> [GroupEntry] -> GroupEntry
scanForGid gid entries = fromMaybe (GroupEntry "?" "" gid []) (find ((== gid) . groupID) entries)
modeString :: FileMode -> String
modeString fm = ""
++ strIfSet "r" ownerReadMode
++ strIfSet "w" ownerWriteMode
++ strIfSet "x" ownerExecuteMode
++ strIfSet "r" groupReadMode
++ strIfSet "w" groupWriteMode
++ strIfSet "x" groupExecuteMode
++ strIfSet "r" otherReadMode
++ strIfSet "w" otherWriteMode
++ strIfSet "x" otherExecuteMode
where
strIfSet s mode = if fm == (fm `unionFileModes` mode) then s else "-"
shortCalendarTimeToString :: UTCTime -> String
shortCalendarTimeToString = formatTime defaultTimeLocale "%b %d %H:%M"
diredMark :: BufferM ()
diredMark = diredMarkWithChar '*' lineDown
diredMarkDel :: BufferM ()
diredMarkDel = diredMarkWithChar 'D' lineDown
diredMarkWithChar :: Char -> BufferM () -> BufferM ()
diredMarkWithChar c mv = bypassReadOnly $ do
maybefile <- fileFromPoint
case maybefile of
Just (fn, _de) -> do
(%=) bufferDynamicValueA (\ds -> ds {diredMarks = M.insert fn c $ diredMarks ds})
filenameColOf mv
diredRefreshMark
Nothing -> filenameColOf mv
diredRefreshMark :: BufferM ()
diredRefreshMark = do b <- pointB
dState <- use bufferDynamicValueA
let posDict = diredFilePoints dState
markMap = diredMarks dState
draw (pos, _, fn) = case M.lookup fn markMap of
Just mark -> do
moveTo pos >> moveToSol >> insertN [mark] >> deleteN 1
e <- pointB
addOverlayB $ mkOverlay UserLayer (mkRegion (e 1) e) (styleOfMark mark)
Nothing ->
moveTo pos >> moveToSol >> insertN [' '] >> deleteN 1
mapM_ draw posDict
moveTo b
where
styleOfMark '*' = const (withFg green)
styleOfMark 'D' = const (withFg red)
styleOfMark _ = defaultStyle
diredUnmark :: BufferM ()
diredUnmark = bypassReadOnly $ do
maybefile <- fileFromPoint
case maybefile of
Just (fn, _de) -> do (%=) bufferDynamicValueA (\ds -> ds {diredMarks = M.delete fn $ diredMarks ds})
filenameColOf lineUp
diredRefreshMark
Nothing -> filenameColOf lineUp
diredUnmarkPath :: FilePath -> BufferM()
diredUnmarkPath fn = (%=) bufferDynamicValueA (\ds -> ds {diredMarks = M.delete fn $ diredMarks ds})
diredUnmarkAll :: BufferM ()
diredUnmarkAll = bypassReadOnly $ do
(%=) bufferDynamicValueA (\ds -> ds {diredMarks = M.empty})
filenameColOf $ return ()
diredRefreshMark
currentDir :: YiM FilePath
currentDir = do
DiredState { diredPath = dir } <- withBuffer $ use bufferDynamicValueA
return dir
askRenameFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askRenameFiles dir fs =
case fs of
(_x:[]) -> do resetDiredOpState
procDiredOp True [DOInput prompt sOpIsDir]
(_x:_) -> do resetDiredOpState
procDiredOp True [DOInput prompt mOpIsDirAndExists]
[] -> procDiredOp True [DOFeedback showNothing]
where prompt = concat ["Move ", show total, " item(s) to:"]
mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps]
where
posOps = map builder fs ++ [DOFeedback showResult]
negOps = [DOFeedback (const $ errorEditor (t ++ " is not directory!"))]
builder (fn, _de) = let old = dir </> fn
new = t </> fn
in DOCkOverwrite new (DORename old new)
sOpIsDir t = [DOCheck (doesDirectoryExist t) posOps sOpDirRename]
where (fn, _) = head fs
posOps = [DOCkOverwrite new (DORename old new),
DOFeedback showResult]
where new = t </> fn
old = dir </> fn
sOpDirRename = [DOCheck ckParentDir posOps' negOps,
DOFeedback showResult]
where posOps' = [DOCkOverwrite new (DORename old new)]
negOps =
[DOFeedback (\_ -> errorEditor $ concat ["Cannot move ", old, " to ", new])]
new = t
old = dir </> fn
ckParentDir = doesDirectoryExist $ takeDirectory (dropTrailingPathSeparator t)
showResult st = do
diredRefresh
msgEditor $ concat [show (diredOpSucCnt st),
" of ", show total, " item(s) moved."]
showNothing _ = msgEditor "Quit"
total = length fs
askCopyFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()
askCopyFiles dir fs =
case fs of
(_x:[]) -> do resetDiredOpState
procDiredOp True [DOInput prompt sOpIsDir]
(_x:_) -> do resetDiredOpState
procDiredOp True [DOInput prompt mOpIsDirAndExists]
[] -> procDiredOp True [DOFeedback showNothing]
where prompt = concat ["Copy ", show total, " item(s) to:"]
mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps]
where
posOps = map builder fs ++ [DOFeedback showResult]
negOps = [DOFeedback $ const $ errorEditor (t ++ " is not directory!")]
builder (fn, de) = let old = dir </> fn
new = t </> fn
in DOCkOverwrite new (op4Type de old new)
sOpIsDir t = [DOCheck (doesDirectoryExist t) posOps sOpDirCopy]
where (fn, de) = head fs
posOps = [DOCkOverwrite new (op4Type de old new),
DOFeedback showResult]
where new = t </> fn
old = dir </> fn
sOpDirCopy = [DOCheck ckParentDir posOps' negOps,
DOFeedback showResult]
where posOps' = [DOCkOverwrite new (op4Type de old new)]
negOps =
[DOFeedback (\_ -> errorEditor $ concat ["Cannot copy ", old, " to ", new])]
new = t
old = dir </> fn
ckParentDir = doesDirectoryExist $ takeDirectory (dropTrailingPathSeparator t)
showResult st = do
diredRefresh
msgEditor $ concat [show (diredOpSucCnt st),
" of ", show total, " item(s) copied."]
showNothing _ = msgEditor "Quit"
total = length fs
op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp
op4Type (DiredDir _) = DOCopyDir
op4Type _ = DOCopyFile
diredRename :: YiM ()
diredRename = do
dir <- currentDir
fs <- markedFiles (`Data.List.elem` ['*'])
if null fs then do maybefile <- withBuffer fileFromPoint
case maybefile of
Just (fn, de) -> askRenameFiles dir [(fn, de)]
Nothing -> noFileAtThisLine
else askRenameFiles dir fs
diredCopy :: YiM ()
diredCopy = do
dir <- currentDir
fs <- markedFiles (`Data.List.elem` ['*'])
if null fs then do maybefile <- withBuffer fileFromPoint
case maybefile of
Just (fn, de) -> askCopyFiles dir [(fn, de)]
Nothing -> noFileAtThisLine
else askCopyFiles dir fs
diredLoad :: YiM ()
diredLoad = do
dir <- currentDir
maybefile <- withBuffer fileFromPoint
case maybefile of
Just (fn, de) -> do let sel = dir </> fn
case de of
(DiredFile _dfi) -> do
exists <- io $ doesFileExist sel
if exists then void $ editFile sel
else msgEditor $ sel ++ " no longer exists"
(DiredDir _dfi) -> do
exists <- io $ doesDirectoryExist sel
if exists then diredDir sel
else msgEditor $ sel ++ " no longer exists"
(DiredSymLink _dfi dest) -> do
let target = if isAbsolute dest then dest else dir </> dest
existsFile <- io $ doesFileExist target
existsDir <- io $ doesDirectoryExist target
msgEditor $ "Following link:"++target
if existsFile then void $ editFile target else
if existsDir then diredDir target else
msgEditor $ target ++ " does not exist"
(DiredSocket _dfi) -> do
exists <- io $ doesFileExist sel
msgEditor (if exists
then "Can't open Socket " ++ sel
else sel ++ " no longer exists")
(DiredBlockDevice _dfi) -> do
exists <- io $ doesFileExist sel
msgEditor (if exists
then "Can't open Block Device " ++ sel
else sel ++ " no longer exists")
(DiredCharacterDevice _dfi) -> do
exists <- io $ doesFileExist sel
msgEditor (if exists
then "Can't open Character Device " ++ sel
else sel ++ " no longer exists")
(DiredNamedPipe _dfi) -> do
exists <- io $ doesFileExist sel
msgEditor (if exists
then "Can't open Pipe " ++ sel
else sel ++ " no longer exists")
DiredNoInfo -> msgEditor $ "No File Info for:"++sel
Nothing -> noFileAtThisLine
noFileAtThisLine :: YiM ()
noFileAtThisLine = msgEditor "(No file at this line)"
fileFromPoint :: BufferM (Maybe (FilePath, DiredEntry))
fileFromPoint = do
p <- pointB
dState <- use bufferDynamicValueA
let candidates = filter (\(_,p2,_)->p<=p2) (diredFilePoints dState)
case candidates of
((_, _, f):_) -> return $ Just (f, M.findWithDefault DiredNoInfo f $ diredEntries dState)
_ -> return Nothing
markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)]
markedFiles cond = do
dState <- withBuffer $ use bufferDynamicValueA
let fs = fst . unzip $ filter (cond . snd) (M.assocs $ diredMarks dState)
return $ map (\f -> (f, diredEntries dState M.! f)) fs
diredUpDir :: YiM ()
diredUpDir = do
dir <- currentDir
diredDir $ takeDirectory dir
diredCreateDir :: YiM ()
diredCreateDir =
withMinibufferGen "" noHint "Create Dir:"
return (const $ return ()) $ \nm -> do
dir <- currentDir
let newdir = dir </> nm
msgEditor $ "Creating "++newdir++"..."
io $ createDirectoryIfMissing True newdir
diredRefresh
data DiredOp = DORemoveFile FilePath
| DORemoveDir FilePath
| DOCopyFile FilePath FilePath
| DOCopyDir FilePath FilePath
| DORename FilePath FilePath
| DORemoveBuffer FilePath
| DOConfirm String [DiredOp] [DiredOp]
| DOCheck (IO Bool) [DiredOp] [DiredOp]
| DOCkOverwrite FilePath DiredOp
| DOInput String (String -> [DiredOp])
| DOChoice String DiredOp
| DOFeedback (DiredOpState -> YiM ())
| DONoOp
data DiredOpState = DiredOpState
{ diredOpSucCnt :: !Int
, diredOpForAll :: Bool
}
deriving (Show, Eq, Typeable)
instance Default DiredOpState where
def = DiredOpState {diredOpSucCnt = 0, diredOpForAll = False}
$(derive makeBinary ''DiredOpState)
instance YiVariable DiredOpState