module Yi.Keymap.Emacs.Utils
( UnivArgument
, argToInt
, askQuitEditor
, askSaveEditor
, modifiedQuitEditor
, withMinibuffer
, queryReplaceE
, isearchKeymap
, cabalConfigureE
, cabalBuildE
, reloadProjectE
, executeExtendedCommandE
, evalRegionE
, readUniversalArg
, scrollDownE
, scrollUpE
, switchBufferE
, killBufferE
, insertNextC
, findFile
, findFileNewTab
, promptFile
, promptTag
, justOneSep
, joinLinesE
)
where
import Control.Applicative
import Control.Monad
import Control.Lens hiding (re,act)
import Data.Foldable (toList)
import Data.List ((\\))
import Data.Maybe (fromMaybe)
import System.FriendlyPath ()
import System.FilePath (takeDirectory, takeFileName, (</>))
import System.Directory
( doesDirectoryExist
)
import Control.Monad.Base
import Yi.Command (cabalConfigureE, cabalBuildE, reloadProjectE)
import Yi.Core
import Yi.Eval
import Yi.File
import Yi.MiniBuffer
import Yi.Misc (promptFile)
import Yi.Regex
import Yi.Tag
import Yi.Search
import Yi.Window
import Yi.Utils
import Yi.Monad
type UnivArgument = Maybe Int
askQuitEditor, askSaveEditor :: YiM ()
askQuitEditor = askIndividualSave True =<< getModifiedBuffers
askSaveEditor = askIndividualSave False =<< getModifiedBuffers
getModifiedBuffers :: YiM [FBuffer]
getModifiedBuffers = filterM deservesSave =<< gets bufferSet
deservesSave :: FBuffer -> YiM Bool
deservesSave b
| isUnchangedBuffer b = return False
| otherwise = isFileBuffer b
isFileBuffer :: (Functor m, MonadBase IO m) => FBuffer -> m Bool
isFileBuffer b = case b ^. identA of
Left _ -> return False
Right fn -> not <$> liftBase (doesDirectoryExist fn)
askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave True [] = modifiedQuitEditor
askIndividualSave False [] = return ()
askIndividualSave hasQuit allBuffers@(firstBuffer : others) =
void (withEditor (spawnMinibufferE saveMessage (const askKeymap)))
where
saveMessage = concat [ "do you want to save the buffer: "
, bufferName
, "? (y/n/"++ (if hasQuit then "q/" else "") ++"c/!)"
]
bufferName = identString firstBuffer
askKeymap = choice ([ char 'n' ?>>! noAction
, char 'y' ?>>! yesAction
, char '!' ?>>! allAction
, oneOf [char 'c', ctrl $ char 'g']
>>! closeBufferAndWindowE
] ++ [char 'q' ?>>! quitEditor | hasQuit])
yesAction = do fwriteBufferE (bkey firstBuffer)
withEditor closeBufferAndWindowE
continue
noAction = do withEditor closeBufferAndWindowE
continue
allAction = do mapM_ fwriteBufferE $ fmap bkey allBuffers
withEditor closeBufferAndWindowE
askIndividualSave hasQuit []
continue = askIndividualSave hasQuit others
modifiedQuitEditor :: YiM ()
modifiedQuitEditor =
do modifiedBuffers <- getModifiedBuffers
if null modifiedBuffers
then quitEditor
else withEditor $ void (spawnMinibufferE modifiedMessage (const askKeymap))
where
modifiedMessage = "Modified buffers exist really quit? (y/n)"
askKeymap = choice [ char 'n' ?>>! noAction
, char 'y' ?>>! quitEditor
]
noAction = closeBufferAndWindowE
selfSearchKeymap :: Keymap
selfSearchKeymap = do
Event (KASCII c) [] <- anyEvent
write (isearchAddE [c])
searchKeymap :: Keymap
searchKeymap = selfSearchKeymap <|> choice
[
ctrl (char 'r') ?>>! isearchPrevE
, ctrl (char 's') ?>>! isearchNextE
, ctrl (char 'w') ?>>! isearchWordE
, meta (char 'p') ?>>! isearchHistory 1
, meta (char 'n') ?>>! isearchHistory (1)
, spec KBS ?>>! isearchDelE
]
isearchKeymap :: Direction -> Keymap
isearchKeymap dir =
do write $ isearchInitE dir
void $ many searchKeymap
choice [ ctrl (char 'g') ?>>! isearchCancelE
, oneOf [ctrl (char 'm'), spec KEnter]
>>! isearchFinishWithE resetRegexE
]
<|| write isearchFinishE
queryReplaceE :: YiM ()
queryReplaceE = withMinibufferFree "Replace:" $ \replaceWhat ->
withMinibufferFree "With:" $ \replaceWith -> do
b <- gets currentBuffer
win <- use currentWindowA
let replaceKm = choice [char 'n' ?>>! qrNext win b re,
char '!' ?>>! qrReplaceAll win b re replaceWith,
oneOf [char 'y', char ' ']
>>! qrReplaceOne win b re replaceWith,
oneOf [char 'q', ctrl (char 'g')] >>! qrFinish
]
Right re = makeSearchOptsM [] replaceWhat
withEditor $ do
setRegexE re
void $ spawnMinibufferE
("Replacing " ++ replaceWhat ++ " with "
++ replaceWith ++ " (y,n,q,!):")
(const replaceKm)
qrNext win b re
executeExtendedCommandE :: YiM ()
executeExtendedCommandE
= withMinibuffer "M-x" (const getAllNamesInScope) execEditorAction
evalRegionE :: YiM ()
evalRegionE = do
void $ withBuffer (getSelectRegionB >>= readRegionB)
return ()
insertNextC :: UnivArgument -> KeymapM ()
insertNextC a = do c <- anyEvent
write $ replicateM_ (argToInt a) $ insertB (eventToChar c)
argToInt :: UnivArgument -> Int
argToInt = fromMaybe 1
digit :: (Event -> Event) -> KeymapM Char
digit f = charOf f '0' '9'
tt :: KeymapM Char
tt = do
Event (KASCII c) _ <- foldr1 (<|>) $ fmap (event . metaCh ) ['0'..'9']
return c
readUniversalArg :: KeymapM (Maybe Int)
readUniversalArg = optional ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4)) <|> (read <$> some tt))
findFile :: YiM ()
findFile = promptFile "find file:" $ \filename -> do
msgEditor $ "loading " ++ filename
void $ editFile filename
findFileNewTab :: YiM ()
findFileNewTab = promptFile "find file (new tab): " $ \filename -> do
withEditor newTabE
msgEditor $ "loading " ++ filename
void $ editFile filename
scrollDownE :: UnivArgument -> BufferM ()
scrollDownE a = case a of
Nothing -> downScreenB
Just n -> scrollB n
scrollUpE :: UnivArgument -> BufferM ()
scrollUpE a = case a of
Nothing -> upScreenB
Just n -> scrollB (negate n)
switchBufferE :: YiM ()
switchBufferE = do
openBufs <- fmap bufkey . toList <$> use windowsA
names <- withEditor $ do
bs <- fmap bkey <$> getBufferStack
let choices = (bs \\ openBufs) ++ openBufs
prefix <- gets commonNamePrefix
forM choices $ \k -> gets (shortIdentString prefix . findBufferWith k)
withMinibufferFin "switch to buffer:" names
(withEditor . switchToBufferWithNameE)
killBufferE :: BufferRef ::: ToKill -> YiM ()
killBufferE (Doc b) = do
buf <- withEditor $ gets $ findBufferWith b
ch <- deservesSave buf
let askKeymap = choice [ char 'n' ?>>! closeBufferAndWindowE
, char 'y' ?>>! delBuf >> closeBufferAndWindowE
, ctrlCh 'g' ?>>! closeBufferAndWindowE
]
delBuf = deleteBuffer b
withEditor $
if ch
then void (spawnMinibufferE (identString buf ++ " changed, close anyway? (y/n)") (const askKeymap))
else delBuf
justOneSep :: BufferM ()
justOneSep = readB >>= \c ->
pointB >>= \point -> case point of
Point 0 -> if isAnySep c then deleteSeparators else insertB ' '
Point x ->
if isAnySep c
then deleteSeparators
else readAtB (Point $ x 1) >>= \d ->
if isAnySep d
then moveB Character Backward >> deleteSeparators
else insertB ' '
where
deleteSeparators = do
genMaybeMoveB unitSepThisLine (Backward, InsideBound) Backward
moveB Character Forward
doIfCharB isAnySep $ deleteB unitSepThisLine Forward
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE a = do case a of
Nothing -> return ()
Just _n -> moveB VLine Forward
moveToSol >> transformB (const " ") Character Backward
>> justOneSep
maybeList :: [a] -> [a] -> [a]
maybeList def [] = def
maybeList _ ls = ls
promptTag :: YiM ()
promptTag = do
defaultTag <- withBuffer $ readUnitB unitWord
tagTable <- withEditor getTags
let hinter = return . take 10 . maybe fail hintTags tagTable
let completer = return . maybe id completeTag tagTable
withMinibufferGen "" hinter ("Find tag: (default " ++ defaultTag ++ ")")
completer (const $ return ()) $
gotoTag . maybeList defaultTag
gotoTag :: Tag -> YiM ()
gotoTag tag =
visitTagTable $ \tagTable ->
case lookupTag tag tagTable of
Nothing -> fail $ "No tags containing " ++ tag
Just (filename, line) -> do
void $ editFile filename
void $ withBuffer $ gotoLn line
return ()
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable act = do
posTagTable <- withEditor getTags
case posTagTable of
Just tagTable -> act tagTable
Nothing ->
promptFile "Visit tags table: (default tags)" $ \path -> do
let filename = maybeList "tags" $ takeFileName path
tagTable <- io $ importTagTable $
takeDirectory path </> filename
withEditor $ setTags tagTable
act tagTable