module Yi.Keymap.Cua ( keymap
, portableKeymap
, customizedCuaKeymapSet
, cut
, paste
, copy
, del
) where
import Control.Applicative (Alternative ((<|>)), (<$>))
import Control.Lens (assign, use)
import Control.Monad (unless, when)
import qualified Data.Text as T (drop, take)
import Yi.Buffer
import Yi.Editor
import Yi.File (fwriteE)
import Yi.Keymap (Keymap, KeymapSet, YiM, modelessKeymapSet, write)
import Yi.Keymap.Emacs.Utils (askQuitEditor, findFile, isearchKeymap)
import Yi.Keymap.Keys
import Yi.MiniBuffer (commentRegion)
import Yi.Misc (adjBlock, selectAll)
import Yi.Rectangle (getRectangle, killRectangle, yankRectangle)
import qualified Yi.Rope as R (YiString, length, singleton, withText)
import Yi.String (lines', unlines')
customizedCuaKeymapSet :: Keymap -> KeymapSet
customizedCuaKeymapSet userKeymap =
modelessKeymapSet $ selfInsertKeymap
<|> move
<|> select
<|> rect
<|> userKeymap
<|> other ctrl
keymap :: KeymapSet
keymap = portableKeymap ctrl
portableKeymap :: (Event -> Event) -> KeymapSet
portableKeymap cmd = modelessKeymapSet $ selfInsertKeymap <|> move <|> select <|> rect <|> other cmd
selfInsertKeymap :: Keymap
selfInsertKeymap = do
c <- printableChar
let action = (withCurrentBuffer . replaceSel $ R.singleton c) :: EditorM ()
write action
setMark :: Bool -> BufferM ()
setMark b = do
isSet <- use highlightSelectionA
assign rectangleSelectionA b
unless isSet $ do
assign highlightSelectionA True
pointB >>= setSelectionMarkPointB
unsetMark :: BufferM ()
unsetMark = assign highlightSelectionA False
replaceSel :: R.YiString -> BufferM ()
replaceSel s = do
hasSel <- use highlightSelectionA
if hasSel
then getSelectRegionB >>= flip replaceRegionB s
else do
when (R.length s == 1) (adjBlock 1)
insertN s
deleteSel :: BufferM () -> YiM ()
deleteSel act = do
haveSelection <- withCurrentBuffer $ use highlightSelectionA
if haveSelection
then withEditor del
else withCurrentBuffer (adjBlock (1) >> act)
cut :: EditorM ()
cut = copy >> del
del :: EditorM ()
del = do
asRect <- withCurrentBuffer $ use rectangleSelectionA
if asRect
then killRectangle
else withCurrentBuffer $ deleteRegionB =<< getSelectRegionB
copy :: EditorM ()
copy =
(setRegE =<<) $ withCurrentBuffer $ do
asRect <- use rectangleSelectionA
if not asRect
then getSelectRegionB >>= readRegionB
else do
(reg, l, r) <- getRectangle
let dropOutside = fmap (T.take (r l) . T.drop l)
R.withText (unlines' . dropOutside . lines') <$> readRegionB reg
paste :: EditorM ()
paste = do
asRect <- withCurrentBuffer (use rectangleSelectionA)
if asRect
then yankRectangle
else withCurrentBuffer . replaceSel =<< getRegE
moveKeys :: [(Event, BufferM ())]
moveKeys = [
(spec KHome , maybeMoveB Line Backward),
(spec KEnd , maybeMoveB Line Forward),
(super (spec KRight) , maybeMoveB Line Forward),
(super (spec KLeft ) , maybeMoveB Line Backward),
(ctrl (spec KHome) , maybeMoveB Document Backward),
(ctrl (spec KEnd) , maybeMoveB Document Forward),
(super (spec KUp) , maybeMoveB Document Backward),
(super (spec KDown) , maybeMoveB Document Forward),
(ctrl (spec KRight) , moveB unitWord Forward),
(ctrl (spec KLeft ) , moveB unitWord Backward),
(spec KUp , moveB VLine Backward),
(spec KDown , moveB VLine Forward),
(spec KRight , moveB Character Forward),
(spec KLeft , moveB Character Backward),
(spec KPageUp , scrollScreensB (1)),
(spec KPageDown , scrollScreensB 1)
]
move, select, rect :: Keymap
other :: (Event -> Event) -> Keymap
move = choice [ k ?>>! unsetMark >> a | (k,a) <- moveKeys]
select = choice [ shift k ?>>! setMark False >> a | (k,a) <- moveKeys]
rect = choice [meta (shift k) ?>>! setMark True >> a | (k,a) <- moveKeys]
other cmd = choice [
spec KBS ?>>! deleteSel bdeleteB,
spec KDel ?>>! deleteSel (deleteN 1),
spec KEnter ?>>! replaceSel $ R.singleton '\n',
cmd (char 'q') ?>>! askQuitEditor,
cmd (char 'f') ?>> isearchKeymap Forward,
cmd (char 'x') ?>>! cut,
cmd (char 'c') ?>>! copy,
cmd (char 'v') ?>>! paste,
cmd (spec KIns) ?>>! copy,
shift (spec KIns) ?>>! paste,
cmd (char 'z') ?>>! undoB,
cmd (char 'y') ?>>! redoB,
cmd (char 's') ?>>! fwriteE,
cmd (char 'o') ?>>! findFile,
cmd (char '/') ?>>! commentRegion,
cmd (char ']') ?>>! autoIndentB IncreaseOnly,
cmd (char '[') ?>>! autoIndentB DecreaseOnly,
cmd (char 'a') ?>>! selectAll
]