module Yi.Misc
where
import Data.Char
( isUpper
, isLower
, chr
, ord
)
import Data.List
( isPrefixOf
, stripPrefix
, (\\)
)
import System.FriendlyPath
( expandTilda
, isAbsolute'
)
import System.FilePath
( takeDirectory
, (</>)
, addTrailingPathSeparator
, hasTrailingPathSeparator
, takeFileName
)
import System.Directory
( doesDirectoryExist
, getDirectoryContents
, getCurrentDirectory
)
import Control.Applicative
import Control.Monad.Base
import Data.Maybe (isNothing)
import System.CanonicalizePath (canonicalizePath, replaceShorthands)
import Yi.Core
import Yi.MiniBuffer
( withMinibufferGen
, mkCompleteFn
)
import Yi.Completion
( completeInList'
)
import Yi.Monad
getAppropriateFiles :: Maybe String -> String -> YiM (String, [ String ])
getAppropriateFiles start s' = do
curDir <- case start of
Nothing -> do bufferPath <- withBuffer $ gets file
liftBase $ getFolder bufferPath
(Just path) -> return path
let s = replaceShorthands s'
sDir = if hasTrailingPathSeparator s then s else takeDirectory s
searchDir
| null sDir = curDir
| isAbsolute' sDir = sDir
| otherwise = curDir </> sDir
searchDir' <- liftBase $ expandTilda searchDir
let fixTrailingPathSeparator f = do
isDir <- doesDirectoryExist (searchDir' </> f)
return $ if isDir then addTrailingPathSeparator f else f
files <- liftBase $ getDirectoryContents searchDir'
let files' = files \\ [ ".", ".." ]
fs <- liftBase $ mapM fixTrailingPathSeparator files'
let matching = filter (isPrefixOf $ takeFileName s) fs
return (sDir, matching)
getFolder :: Maybe String -> IO String
getFolder Nothing = getCurrentDirectory
getFolder (Just path) = do
isDir <- doesDirectoryExist path
let dir = if isDir then path else takeDirectory path
if null dir then getCurrentDirectory else return dir
matchingFileNames :: Maybe String -> String -> YiM [String]
matchingFileNames start s = do
(sDir, files) <- getAppropriateFiles start s
let results = if isNothing start && sDir == "." && not ("./" `isPrefixOf` s)
then files
else fmap (sDir </>) files
return results
adjBlock :: Int -> BufferM ()
adjBlock x = withSyntaxB' (\m s -> modeAdjustBlock m s x)
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent ib = withSyntaxB' (\m s -> modeIndent m s ib)
promptFile :: String -> (String -> YiM ()) -> YiM ()
promptFile prompt act = do
maybePath <- withBuffer $ gets file
startPath <- addTrailingPathSeparator
<$> liftBase (canonicalizePath =<< getFolder maybePath)
withMinibufferGen startPath (findFileHint startPath) prompt
(completeFile startPath) showCanon (act . replaceShorthands)
where
showCanon = withBuffer . replaceBufferContent . replaceShorthands
matchFile :: String -> String -> Maybe String
matchFile path proposedCompletion =
let realPath = replaceShorthands path
in (path ++) <$> stripPrefix realPath proposedCompletion
completeFile :: String -> String -> YiM String
completeFile startPath = mkCompleteFn completeInList' matchFile $ matchingFileNames (Just startPath)
findFileHint :: String -> String -> YiM [String]
findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s
onCharLetterCode :: (Int -> Int) -> Char -> Char
onCharLetterCode f c | isUpper c || isLower c = chr (f (ord c a) `mod` 26 + a)
| otherwise = c
where a | isUpper c = ord 'A'
| isLower c = ord 'a'
| otherwise = undefined
rot13Char :: Char -> Char
rot13Char = onCharLetterCode (+13)
printFileInfoE :: EditorM ()
printFileInfoE = printMsg . showBufInfo =<< withBuffer0 bufInfoB
where showBufInfo :: BufferFileInfo -> String
showBufInfo bufInfo = concat [ show $ bufInfoFileName bufInfo
, " Line "
, show $ bufInfoLineNo bufInfo
, " ["
, bufInfoPercent bufInfo
, "]"
]