module Yi.Keymap.Cua ( keymap
, portableKeymap
, customizedCuaKeymapSet
, cut
, paste
, copy
, del
) where
import Control.Applicative
import Control.Lens hiding (act)
import Control.Monad
import qualified Data.Text as T
import Yi.Buffer
import Yi.Editor
import Yi.File
import Yi.Keymap
import Yi.Keymap.Emacs.Utils
import Yi.Keymap.Keys
import Yi.MiniBuffer
import Yi.Misc (adjBlock, selectAll)
import Yi.Rectangle
import qualified Yi.Rope as R
import Yi.String
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
]