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 Prelude (take)
import Data.List ((\\))
import Data.Maybe (maybe)
import System.FriendlyPath ()
import System.FilePath (takeDirectory, takeFileName, (</>))
import System.Directory
( doesDirectoryExist
)
import Control.Monad.Trans (MonadIO (..))
import Control.Monad (filterM, replicateM_)
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
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, MonadIO m) => FBuffer -> m Bool
isFileBuffer b = case b ^. identA of
Left _ -> return False
Right fn -> not <$> liftIO (doesDirectoryExist fn)
askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave True [] = modifiedQuitEditor
askIndividualSave False [] = return ()
askIndividualSave hasQuit allBuffers@(firstBuffer : others) =
withEditor (spawnMinibufferE saveMessage (const askKeymap)) >> return ()
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 $ spawnMinibufferE modifiedMessage (const askKeymap) >> return ()
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
discard $ many searchKeymap
choice [ ctrl (char 'g') ?>>! isearchCancelE
, oneOf [ctrl (char 'm'), spec KEnter] >>! isearchFinishE
]
<|| write isearchFinishE
queryReplaceE :: YiM ()
queryReplaceE = do
withMinibufferFree "Replace:" $ \replaceWhat -> do
withMinibufferFree "With:" $ \replaceWith -> do
b <- gets currentBuffer
win <- getA 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
discard $ 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
discard $ withBuffer (getSelectRegionB >>= readRegionB) >>= return
return ()
insertNextC :: UnivArgument -> KeymapM ()
insertNextC a = do c <- anyEvent
write $ replicateM_ (argToInt a) $ insertB (eventToChar c)
argToInt :: UnivArgument -> Int
argToInt a = case a of
Nothing -> 1
Just x -> x
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 =
Just <$> ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4))
<|> (read <$> (some tt)))
<|> pure Nothing
findFile :: YiM ()
findFile = promptFile "find file:" $ \filename -> do
msgEditor $ "loading " ++ filename
discard $ editFile filename
findFileNewTab :: YiM ()
findFileNewTab = promptFile "find file (new tab): " $ \filename -> do
withEditor newTabE
msgEditor $ "loading " ++ filename
discard $ 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 <$> getA 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 (spawnMinibufferE (identString buf ++ " changed, close anyway? (y/n)") (const askKeymap)) >> return ()
else delBuf
justOneSep :: BufferM ()
justOneSep = doIfCharB isAnySep $ 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 (\_ -> " ") 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 $
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
discard $ editFile filename
discard $ 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