Changes to make CUA independent of EMACS

yi-keymap-cua/src/Yi/Keymap/Cua.hs

@@ -20,20 +20,20 @@ module Yi.Keymap.Cua ( keymap
 
 import           Control.Applicative      (Alternative ((<|>)))
 import           Lens.Micro.Platform      ((.=), use)
-import           Control.Monad            (unless, when)
+import           Control.Monad            (unless)
 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.Cua.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 qualified Yi.Rope                  as R (YiString, singleton, withText)
 import           Yi.String                (lines', unlines')
-import           Yi.Keymap.Emacs.KillRing (clipboardToKillring, killringToClipboard)
+import           Yi.Keymap.Cua.KillRing (clipboardToKillring, killringToClipboard)
 
 customizedCuaKeymapSet :: Keymap -> KeymapSet
 customizedCuaKeymapSet userKeymap =

yi-keymap-cua/src/Yi/Keymap/Cua/KillRing.hs

@@ -0,0 +1,57 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+{-# language RankNTypes #-}
+
+-- |
+-- Module      :  Yi.Keymap.Cua.KillRing
+-- License     :  GPL-2
+-- Maintainer  :  [email protected]
+-- Stability   :  experimental
+-- Portability :  portable
+
+module Yi.Keymap.Cua.KillRing ( clipboardToKillring
+                              , killringToClipboard
+                              ) where
+
+import           Lens.Micro.Platform (use, (%=), Getting)
+import           Control.Monad       (when)
+import           Control.Monad.State.Class (MonadState)
+import           Data.List.NonEmpty  (NonEmpty ((:|)))
+import           Yi.Buffer
+import           Yi.Editor           (EditorM, killringA)
+import           Yi.Keymap           (YiM)
+import           Yi.KillRing         (Killring (_krContents), krPut)
+import qualified Yi.Rope             as R (YiString, fromString, toString)
+import           Yi.Types            (withEditor)
+import           Yi.Utils            (io)
+import           System.Hclip        (getClipboard, setClipboard)
+
+
+uses :: forall a b f s. MonadState s f => Getting a s a -> (a -> b) -> f b
+uses l f = f <$> use l
+
+
+-- * Killring actions
+
+-- | Adds system clipboard's contents on top of the killring if not already there
+clipboardToKillring :: YiM ()
+clipboardToKillring = do
+  text <- fmap R.fromString $ io getClipboard
+  withEditor $ do
+    text' <- killringGet
+    when (text' /= text) $ killringPut Forward text
+
+-- | Adds the top of the killring to the system clipboard
+killringToClipboard :: YiM ()
+killringToClipboard = do
+  text <- withEditor killringGet
+  io . setClipboard $ R.toString text
+
+
+killringGet :: EditorM R.YiString
+killringGet = do
+  text :| _ <- uses killringA _krContents
+  return text
+
+killringPut :: Direction -> R.YiString -> EditorM ()
+killringPut dir s = killringA %= krPut dir s
+

yi-keymap-cua/src/Yi/Keymap/Cua/Utils.hs

@@ -0,0 +1,157 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# OPTIONS_HADDOCK show-extensions #-}
+
+-- |
+-- Module      :  Yi.Keymap.Cua.Utils
+-- License     :  GPL-2
+-- Maintainer  :  [email protected]
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module is aimed at being a helper for the Cua keybindings.
+-- In particular this should be useful for anyone that has a custom
+-- keymap derived from or based on the Emacs one.
+
+module Yi.Keymap.Cua.Utils
+  ( askQuitEditor
+  , isearchKeymap
+  , findFile
+  )
+where
+
+import           Control.Applicative (Alternative ((<|>), many))
+import           Control.Monad       (filterM, void)
+import           Control.Monad.Base  ()
+import           Data.Monoid         ((<>))
+import qualified Data.Text           as T (Text, concat, singleton, unpack)
+import           System.FriendlyPath ()
+import           Yi.Buffer
+import           Yi.Core             (quitEditor)
+import           Yi.Editor
+import           Yi.File             (deservesSave, fwriteBufferE, openingNewFile)
+import           Yi.Keymap           (Keymap, YiM, write)
+import           Yi.Keymap.Keys
+import           Yi.MiniBuffer
+import           Yi.Misc             (promptFile)
+import           Yi.Monad            (gets)
+import           Yi.Search
+
+
+----------------------------
+-- | Quits the editor if there are no unmodified buffers
+-- if there are unmodified buffers then we ask individually for
+-- each modified buffer whether or not the user wishes to save
+-- it or not. If we get to the end of this list and there are still
+-- some modified buffers then we ask again if the user wishes to
+-- quit, but this is then a simple yes or no.
+askQuitEditor :: YiM ()
+askQuitEditor = askIndividualSave True =<< getModifiedBuffers
+
+getModifiedBuffers :: YiM [FBuffer]
+getModifiedBuffers = filterM deservesSave =<< gets bufferSet
+
+--------------------------------------------------
+-- Takes in a list of buffers which have been identified
+-- as modified since their last save.
+
+askIndividualSave :: Bool -> [FBuffer] -> YiM ()
+askIndividualSave True []  = modifiedQuitEditor
+askIndividualSave False [] = return ()
+askIndividualSave hasQuit allBuffers@(firstBuffer : others) =
+  void (withEditor (spawnMinibufferE saveMessage (const askKeymap)))
+  where
+  saveMessage = T.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
+                        -- cancel
+                      ] ++ [char 'q' ?>>! quitEditor | hasQuit])
+  yesAction = do void $ 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
+
+---------------------------
+
+---------------------------
+-- | Quits the editor if there are no unmodified buffers
+-- if there are then simply confirms with the user that they
+-- with to quit.
+modifiedQuitEditor :: YiM ()
+modifiedQuitEditor =
+  do modifiedBuffers <- getModifiedBuffers
+     if null modifiedBuffers
+        then quitEditor
+        else withEditor $ void (spawnMinibufferE modifiedMessage (const askKeymap))
+  where
+  modifiedMessage = "Modified buffers exist really quit? (y/n)"
+
+  askKeymap = choice [ char 'n' ?>>! noAction
+                     , char 'y' ?>>! quitEditor
+                     ]
+
+  noAction        = closeBufferAndWindowE
+
+-----------------------------
+-- isearch
+selfSearchKeymap :: Keymap
+selfSearchKeymap = do
+  Event (KASCII c) [] <- anyEvent
+  write . isearchAddE $ T.singleton c
+
+searchKeymap :: Keymap
+searchKeymap = selfSearchKeymap <|> choice
+               [ -- ("C-g", isearchDelE) -- Only if string is not empty.
+                 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
+     void $ many searchKeymap
+     choice [ ctrl (char 'g') ?>>! isearchCancelE
+            , oneOf [ctrl (char 'm'), spec KEnter]
+              >>! isearchFinishWithE resetRegexE
+            ]
+       <|| write isearchFinishE
+
+
+-- | Finds file and runs specified action on the resulting buffer
+findFileAndDo :: T.Text -- ^ Prompt
+              -> BufferM a -- ^ Action to run on the resulting buffer
+              -> YiM ()
+findFileAndDo prompt act = promptFile prompt $ \filename -> do
+  printMsg $ "loading " <> filename
+  openingNewFile (T.unpack filename) act
+
+-- | Open a file using the minibuffer. We have to set up some stuff to
+-- allow hints and auto-completion.
+findFile :: YiM ()
+findFile = findFileAndDo "find file:" $ return ()
+

yi-keymap-cua/yi-keymap-cua.cabal

@@ -20,13 +20,20 @@ library
   build-depends:
       base >= 4.8 && < 5
     , microlens-platform
+    -- 'mtl' library needed for KillRing.hs
+    , mtl
+    -- 'Hclip', 'text', and 'transformers-base' libraries needed for Utils.hs
+    , Hclip
     , text
+    , transformers-base
     , yi-core >= 0.18
-    , yi-keymap-emacs >= 0.18
+    , yi-language >= 0.18
     , yi-rope >= 0.10
   exposed-modules:
       Yi.Config.Default.Cua
       Yi.Keymap.Cua
+      Yi.Keymap.Cua.KillRing
+      Yi.Keymap.Cua.Utils
   other-modules:
       Paths_yi_keymap_cua
   default-language: Haskell2010