{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Cua
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Cua keymap.

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

-- | Introduce a keymap that is compatible with both windows and osx,
--   by parameterising the event modifier required for commands
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
 ]