module Yi.Misc ( getAppropriateFiles, getFolder, cd, pwd, matchingFileNames
, rot13Char, placeMark, selectAll, adjIndent
, promptFile , promptFileChangingHints, matchFile, completeFile
, printFileInfoE, debugBufferContent
) where
import Control.Concurrent
import Control.Monad (filterM, (>=>), when, void)
import Control.Monad.Base (liftBase)
import Data.Char (chr, isAlpha, isLower, isUpper, ord)
import Data.IORef
import Data.List ((\\))
import Data.Maybe (isNothing)
import qualified Data.Text as T (Text, append, concat, isPrefixOf,
pack, stripPrefix, unpack)
import System.CanonicalizePath (canonicalizePath, replaceShorthands, replaceShorthands)
import System.Directory (doesDirectoryExist,
getCurrentDirectory,
getDirectoryContents,
setCurrentDirectory)
import System.Environment (lookupEnv)
import System.FilePath (addTrailingPathSeparator,
hasTrailingPathSeparator,
takeDirectory, takeFileName, (</>))
import System.FriendlyPath (expandTilda, isAbsolute')
import Yi.Buffer
import Yi.Completion (completeInList')
import Yi.Core (onYiVar)
import Yi.Editor (EditorM, printMsg, withCurrentBuffer, withGivenBuffer, findBuffer)
import Yi.Keymap (YiM, makeAction, YiAction)
import Yi.MiniBuffer (mkCompleteFn, withMinibufferGen, promptingForBuffer)
import Yi.Monad (gets)
import qualified Yi.Rope as R (fromText, YiString)
import Yi.Types (IsRefreshNeeded(..), Yi(..))
import Yi.Utils (io)
getAppropriateFiles :: Maybe T.Text -> T.Text -> YiM (T.Text, [ T.Text ])
getAppropriateFiles start s' = do
curDir <- case start of
Nothing -> do bufferPath <- withCurrentBuffer $ gets file
liftBase $ getFolder bufferPath
Just path -> return $ T.unpack path
let s = T.unpack $ 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 . T.pack $ if isDir then addTrailingPathSeparator f else f
files <- liftBase $ getDirectoryContents searchDir'
let files' = files \\ [ ".", ".." ]
fs <- liftBase $ mapM fixTrailingPathSeparator files'
let matching = filter (T.isPrefixOf . T.pack $ takeFileName s) fs
return (T.pack 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 T.Text -> T.Text -> YiM [T.Text]
matchingFileNames start s = do
(sDir, files) <- getAppropriateFiles start s
let results = if isNothing start && sDir == "." && not ("./" `T.isPrefixOf` s)
then files
else fmap (T.pack . (T.unpack sDir </>) . T.unpack) files
return results
placeMark :: BufferM ()
placeMark = (==) <$> pointB <*> getSelectionMarkPointB >>= \case
True -> setVisibleSelection False
False -> setVisibleSelection True >> pointB >>= setSelectionMarkPointB
selectAll :: BufferM ()
selectAll = botB >> placeMark >> topB >> setVisibleSelection True
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent ib = withSyntaxB' (\m s -> modeIndent m s ib)
promptFile :: T.Text -> (T.Text -> YiM ()) -> YiM ()
promptFile prompt act = promptFileChangingHints prompt (const return) act
promptFileChangingHints :: T.Text
-> (T.Text -> [T.Text] -> YiM [T.Text])
-> (T.Text -> YiM ())
-> YiM ()
promptFileChangingHints prompt ht act = do
maybePath <- withCurrentBuffer $ gets file
startPath <- T.pack . addTrailingPathSeparator
<$> liftBase (canonicalizePath =<< getFolder maybePath)
withMinibufferGen startPath (\x -> findFileHint startPath x >>= ht x) prompt
(completeFile startPath) showCanon (act . replaceShorthands)
where
showCanon = withCurrentBuffer . replaceBufferContent . R.fromText . replaceShorthands
matchFile :: T.Text -> T.Text -> Maybe T.Text
matchFile path proposedCompletion =
let realPath = replaceShorthands path
in T.append path <$> T.stripPrefix realPath proposedCompletion
completeFile :: T.Text -> T.Text -> YiM T.Text
completeFile startPath =
mkCompleteFn completeInList' matchFile $ matchingFileNames (Just startPath)
findFileHint :: T.Text -> T.Text -> YiM [T.Text]
findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s
onCharLetterCode :: (Int -> Int) -> Char -> Char
onCharLetterCode f c | isAlpha c = chr (f (ord c a) `mod` 26 + a)
| otherwise = c
where a | isUpper c = ord 'A'
| isLower c = ord 'a'
| otherwise = undefined
cd :: YiM ()
cd = promptFileChangingHints "switch directory to:" dirs $ \path ->
io $ getFolder (Just $ T.unpack path) >>= clean . T.pack
>>= System.Directory.setCurrentDirectory . addTrailingPathSeparator
where
replaceHome p@('~':'/':xs) = lookupEnv "HOME" >>= return . \case
Nothing -> p
Just h -> h </> xs
replaceHome p = return p
clean = replaceHome . T.unpack . replaceShorthands >=> canonicalizePath
x <//> y = T.pack $ takeDirectory (T.unpack x) </> T.unpack y
dirs :: T.Text -> [T.Text] -> YiM [T.Text]
dirs x xs = do
xsc <- io $ mapM (\y -> (,y) <$> clean (x <//> y)) xs
filterM (io . doesDirectoryExist . fst) xsc >>= return . map snd
pwd :: YiM ()
pwd = io getCurrentDirectory >>= printMsg . T.pack
rot13Char :: Char -> Char
rot13Char = onCharLetterCode (+13)
printFileInfoE :: EditorM ()
printFileInfoE = printMsg . showBufInfo =<< withCurrentBuffer bufInfoB
where showBufInfo :: BufferFileInfo -> T.Text
showBufInfo bufInfo = T.concat
[ T.pack $ bufInfoFileName bufInfo
, " Line "
, T.pack . show $ bufInfoLineNo bufInfo
, " ["
, bufInfoPercent bufInfo
, "]"
]
forkAction :: (YiAction a x, Show x)
=> IO Bool
-> IsRefreshNeeded
-> a
-> YiM ThreadId
forkAction delay ref ym = onYiVar $ \yi yv -> do
let loop = do
yiOutput yi ref [makeAction ym]
delay >>= \b -> when b loop
t <- forkIO loop
return (yv, t)
debugBufferContent :: YiM ()
debugBufferContent = promptingForBuffer "buffer to trace:"
debugBufferContentUsing (\_ x -> x)
debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing b = do
mv <- io $ newIORef mempty
keepGoing <- io $ newIORef True
let delay = threadDelay 100000 >> readIORef keepGoing
void . forkAction delay NoNeedToRefresh $
findBuffer b >>= \case
Nothing -> io $ writeIORef keepGoing True
Just _ -> do
ns <- withGivenBuffer b elemsB :: YiM R.YiString
io $ readIORef mv >>= \c ->
when (c /= ns) (print ns >> void (writeIORef mv ns))