{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Cua ( keymap
, portableKeymap
, customizedCuaKeymapSet
, cut
, paste
, copy
, del
) where
import Control.Applicative (Alternative ((<|>)))
import Lens.Micro.Platform ((.=), 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 (selectAll)
import Yi.Rectangle (getRectangle, killRectangle, yankRectangle)
import qualified Yi.Rope as R (YiString, length, singleton, withText)
import Yi.String (lines', unlines')
import Yi.Keymap.Emacs.KillRing (clipboardToKillring, killringToClipboard)
customizedCuaKeymapSet :: Keymap -> KeymapSet
customizedCuaKeymapSet :: Keymap -> KeymapSet
customizedCuaKeymapSet Keymap
userKeymap =
Keymap -> KeymapSet
modelessKeymapSet (Keymap -> KeymapSet) -> Keymap -> KeymapSet
forall a b. (a -> b) -> a -> b
$ Keymap
selfInsertKeymap
Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
move
Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
select
Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
rect
Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
userKeymap
Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Event -> Event) -> Keymap
other Event -> Event
ctrl
keymap :: KeymapSet
keymap :: KeymapSet
keymap = (Event -> Event) -> KeymapSet
portableKeymap Event -> Event
ctrl
portableKeymap :: (Event -> Event) -> KeymapSet
portableKeymap :: (Event -> Event) -> KeymapSet
portableKeymap Event -> Event
cmd = Keymap -> KeymapSet
modelessKeymapSet (Keymap -> KeymapSet) -> Keymap -> KeymapSet
forall a b. (a -> b) -> a -> b
$ Keymap
selfInsertKeymap Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
move Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
select Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keymap
rect Keymap -> Keymap -> Keymap
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Event -> Event) -> Keymap
other Event -> Event
cmd
selfInsertKeymap :: Keymap
selfInsertKeymap :: Keymap
selfInsertKeymap = do
Char
c <- I Event Action Char
forall (m :: * -> *) w.
(MonadFail m, MonadInteract m w Event) =>
m Char
printableChar
let action :: EditorM ()
action = (BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ())
-> (YiString -> BufferM ()) -> YiString -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
replaceSel (YiString -> EditorM ()) -> YiString -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Char -> YiString
R.singleton Char
c) :: EditorM ()
EditorM () -> Keymap
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write EditorM ()
action
setMark :: Bool -> BufferM ()
setMark :: Bool -> BufferM ()
setMark Bool
b = do
Bool
isSet <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
rectangleSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
b
Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isSet (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
(Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB
unsetMark :: BufferM ()
unsetMark :: BufferM ()
unsetMark = (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
replaceSel :: R.YiString -> BufferM ()
replaceSel :: YiString -> BufferM ()
replaceSel YiString
s = do
Bool
hasSel <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA
if Bool
hasSel
then BufferM Region
getSelectRegionB BufferM Region -> (Region -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Region -> YiString -> BufferM ())
-> YiString -> Region -> BufferM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Region -> YiString -> BufferM ()
replaceRegionB YiString
s
else YiString -> BufferM ()
insertN YiString
s
deleteSel :: BufferM () -> YiM ()
deleteSel :: BufferM () -> YiM ()
deleteSel BufferM ()
act = do
Bool
haveSelection <- BufferM Bool -> YiM Bool
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Bool -> YiM Bool) -> BufferM Bool -> YiM Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA
if Bool
haveSelection
then EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
del
else BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ()
act
cut :: YiM ()
cut :: YiM ()
cut = YiM ()
copy YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
del
del :: EditorM ()
del :: EditorM ()
del = do
Bool
asRect <- BufferM Bool -> EditorM Bool
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Bool -> EditorM Bool) -> BufferM Bool -> EditorM Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
rectangleSelectionA
if Bool
asRect
then EditorM ()
killRectangle
else BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB
copy :: YiM ()
copy :: YiM ()
copy = do
YiString
text <- BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> YiM YiString)
-> BufferM YiString -> YiM YiString
forall a b. (a -> b) -> a -> b
$ do
Bool
asRect <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
rectangleSelectionA
if Bool -> Bool
not Bool
asRect
then BufferM Region
getSelectRegionB BufferM Region -> (Region -> BufferM YiString) -> BufferM YiString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Region -> BufferM YiString
readRegionB
else do
(Region
reg, Int
l, Int
r) <- BufferM (Region, Int, Int)
getRectangle
let dropOutside :: [Text] -> [Text]
dropOutside = (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.take (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
l)
(Text -> Text) -> YiString -> YiString
R.withText ([Text] -> Text
unlines' ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
dropOutside ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
lines') (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> BufferM YiString
readRegionB Region
reg
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ YiString -> EditorM ()
setRegE YiString
text
YiM ()
killringToClipboard
paste :: YiM ()
paste :: YiM ()
paste = do
YiM ()
clipboardToKillring
Bool
asRect <- BufferM Bool -> YiM Bool
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
rectangleSelectionA)
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
if Bool
asRect then EditorM ()
yankRectangle
else BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ())
-> (YiString -> BufferM ()) -> YiString -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
replaceSel (YiString -> EditorM ()) -> EditorM YiString -> EditorM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EditorM YiString
getRegE
moveKeys :: [(Event, BufferM ())]
moveKeys :: [(Event, BufferM ())]
moveKeys = [
(Key -> Event
spec Key
KHome , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Backward),
(Key -> Event
spec Key
KEnd , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Forward),
(Event -> Event
super (Key -> Event
spec Key
KRight) , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Forward),
(Event -> Event
super (Key -> Event
spec Key
KLeft ) , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Backward),
(Event -> Event
ctrl (Key -> Event
spec Key
KHome) , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Document Direction
Backward),
(Event -> Event
ctrl (Key -> Event
spec Key
KEnd) , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Document Direction
Forward),
(Event -> Event
super (Key -> Event
spec Key
KUp) , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Document Direction
Backward),
(Event -> Event
super (Key -> Event
spec Key
KDown) , TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Document Direction
Forward),
(Event -> Event
ctrl (Key -> Event
spec Key
KRight) , TextUnit -> Direction -> BufferM ()
moveB TextUnit
unitWord Direction
Forward),
(Event -> Event
ctrl (Key -> Event
spec Key
KLeft ) , TextUnit -> Direction -> BufferM ()
moveB TextUnit
unitWord Direction
Backward),
(Key -> Event
spec Key
KUp , TextUnit -> Direction -> BufferM ()
moveB TextUnit
VLine Direction
Backward),
(Key -> Event
spec Key
KDown , TextUnit -> Direction -> BufferM ()
moveB TextUnit
VLine Direction
Forward),
(Key -> Event
spec Key
KRight , TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Forward),
(Key -> Event
spec Key
KLeft , TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Backward),
(Key -> Event
spec Key
KPageUp , Int -> BufferM ()
scrollScreensB (-Int
1)),
(Key -> Event
spec Key
KPageDown , Int -> BufferM ()
scrollScreensB Int
1)
]
move, select, rect :: Keymap
other :: (Event -> Event) -> Keymap
move :: Keymap
move = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Event
k Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
unsetMark BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
a | (Event
k,BufferM ()
a) <- [(Event, BufferM ())]
moveKeys]
select :: Keymap
select = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Event -> Event
shift Event
k Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Bool -> BufferM ()
setMark Bool
False BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
a | (Event
k,BufferM ()
a) <- [(Event, BufferM ())]
moveKeys]
rect :: Keymap
rect = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [Event -> Event
meta (Event -> Event
shift Event
k) Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Bool -> BufferM ()
setMark Bool
True BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
a | (Event
k,BufferM ()
a) <- [(Event, BufferM ())]
moveKeys]
other :: (Event -> Event) -> Keymap
other Event -> Event
cmd = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [
Key -> Event
spec Key
KBS Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM () -> YiM ()
deleteSel BufferM ()
bdeleteB,
Key -> Event
spec Key
KDel Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM () -> YiM ()
deleteSel (Int -> BufferM ()
deleteN Int
1),
Key -> Event
spec Key
KEnter Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiString -> BufferM ()
replaceSel (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char -> YiString
R.singleton Char
'\n',
Event -> Event
cmd (Char -> Event
char Char
'q') Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
askQuitEditor,
Event -> Event
cmd (Char -> Event
char Char
'f') Event -> Keymap -> Keymap
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> Direction -> Keymap
isearchKeymap Direction
Forward,
Event -> Event
cmd (Char -> Event
char Char
'x') Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
cut,
Event -> Event
cmd (Char -> Event
char Char
'c') Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
copy,
Event -> Event
cmd (Char -> Event
char Char
'v') Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
paste,
Event -> Event
cmd (Key -> Event
spec Key
KIns) Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
copy,
Event -> Event
shift (Key -> Event
spec Key
KIns) Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
paste,
Event -> Event
cmd (Char -> Event
char Char
'z') Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
undoB,
Event -> Event
cmd (Char -> Event
char Char
'y') Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
redoB,
Event -> Event
cmd (Char -> Event
char Char
's') Event -> YiM Bool -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM Bool
fwriteE,
Event -> Event
cmd (Char -> Event
char Char
'o') Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
findFile,
Event -> Event
cmd (Char -> Event
char Char
'/') Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
commentRegion,
Event -> Event
cmd (Char -> Event
char Char
']') Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! IndentBehaviour -> BufferM ()
autoIndentB IndentBehaviour
IncreaseOnly,
Event -> Event
cmd (Char -> Event
char Char
'[') Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! IndentBehaviour -> BufferM ()
autoIndentB IndentBehaviour
DecreaseOnly,
Event -> Event
cmd (Char -> Event
char Char
'a') Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
selectAll
]