    {-# LANGUAGE OverloadedStrings #-}
    module Yi.Config.Default.Emacs (configureEmacs) where

    import           Lens.Micro.Platform ((%=), (.=), (.~))
    import           Yi.Buffer.Misc    (identA, directoryContentA)
    import           Yi.Config.Misc    (ScrollStyle (..))
    import           Yi.Editor         (buffersA, newBufferE)
    import           Yi.Event          (Modifier (..), Key (..), Event (..))
    import           Yi.Interact       (mkAutomaton, anyEvent, write, (||>), event, P)
    import           Yi.Keymap         (makeAction)
    import           Yi.Keymap.Emacs   (keymap)
    import           Yi.Keymap.Keys    (printableChar, spec)
    import           Yi.Config.Lens
    import           Yi.Config.Simple  (ConfigM)
    import qualified Yi.Rope           as R
    import           Yi.Types

    import           Control.Monad       (forever, unless, void)
    import qualified Data.Map            as M
    import           Lens.Micro.Platform (use, (^.))

    configureEmacs :: ConfigM ()
    configureEmacs :: ConfigM ()
    configureEmacs = do
      (UIConfig -> Identity UIConfig) -> Config -> Identity Config
    Lens' Config UIConfig
    configUIA ((UIConfig -> Identity UIConfig) -> Config -> Identity Config)
    -> (UIConfig -> UIConfig) -> ConfigM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= ((Maybe ScrollStyle -> Identity (Maybe ScrollStyle))
    -> UIConfig -> Identity UIConfig
    Lens' UIConfig (Maybe ScrollStyle)
    configScrollStyleA ((Maybe ScrollStyle -> Identity (Maybe ScrollStyle))
     -> UIConfig -> Identity UIConfig)
    -> Maybe ScrollStyle -> UIConfig -> UIConfig
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ ScrollStyle -> Maybe ScrollStyle
    forall a. a -> Maybe a
    Just ScrollStyle
    SnapToCenter)
      (KeymapSet -> Identity KeymapSet) -> Config -> Identity Config
    Lens' Config KeymapSet
    defaultKmA ((KeymapSet -> Identity KeymapSet) -> Config -> Identity Config)
    -> KeymapSet -> ConfigM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= KeymapSet
    keymap
      ([Action] -> Identity [Action]) -> Config -> Identity Config
    Lens' Config [Action]
    startActionsA (([Action] -> Identity [Action]) -> Config -> Identity Config)
    -> ([Action] -> [Action]) -> ConfigM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= (YiM () -> Action
    forall a x. (YiAction a x, Show x) => a -> Action
    makeAction YiM ()
    openScratchBuffer Action -> [Action] -> [Action]
    forall a. a -> [a] -> [a]
    :)
      (P Event Event -> Identity (P Event Event))
    -> Config -> Identity Config
    Lens' Config (P Event Event)
    configInputPreprocessA ((P Event Event -> Identity (P Event Event))
     -> Config -> Identity Config)
    -> P Event Event -> ConfigM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= P Event Event
    escToMeta
      (Bool -> Identity Bool) -> Config -> Identity Config
    Lens' Config Bool
    configKillringAccumulateA ((Bool -> Identity Bool) -> Config -> Identity Config)
    -> Bool -> ConfigM ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Bool
    True

    -- | Input preprocessor: Transform Esc;Char into Meta-Char
    -- Useful for emacs lovers ;)
    escToMeta :: P Event Event
    escToMeta :: P Event Event
    escToMeta = I Event Event (ZonkAny 0) -> P Event Event
    forall w ev a. Eq w => I ev w a -> P ev w
    mkAutomaton (I Event Event (ZonkAny 0) -> P Event Event)
    -> I Event Event (ZonkAny 0) -> P Event Event
    forall a b. (a -> b) -> a -> b
    $ I Event Event () -> I Event Event (ZonkAny 0)
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (I Event Event () -> I Event Event (ZonkAny 0))
    -> I Event Event () -> I Event Event (ZonkAny 0)
    forall a b. (a -> b) -> a -> b
    $ (I Event Event Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    m event
    anyEvent I Event Event Event
    -> (Event -> I Event Event ()) -> I Event Event ()
    forall a b.
    I Event Event a -> (a -> I Event Event b) -> I Event Event b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Event -> I Event Event ()
    forall (m :: * -> *) w e. MonadInteract m w e => w -> m ()
    write) I Event Event () -> I Event Event () -> I Event Event ()
    forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    ||> do
        _ <- Event -> I Event Event Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    event -> m event
    event (Key -> Event
    spec Key
    KEsc)
        c <- printableChar
        write (Event (KASCII c) [MMeta])

    -- | Open an emacs-like scratch buffer if no file is open.
    openScratchBuffer :: YiM ()
    openScratchBuffer :: YiM ()
    openScratchBuffer = EditorM () -> YiM ()
    forall a. EditorM a -> YiM a
    forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
    withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
    forall a b. (a -> b) -> a -> b
    $ do
      fileBufOpen <- (FBuffer -> Bool) -> [FBuffer] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any FBuffer -> Bool
    isFileOrDir ([FBuffer] -> Bool)
    -> (Map BufferRef FBuffer -> [FBuffer])
    -> Map BufferRef FBuffer
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map BufferRef FBuffer -> [FBuffer]
    forall k a. Map k a -> [a]
    M.elems (Map BufferRef FBuffer -> Bool)
    -> EditorM (Map BufferRef FBuffer) -> EditorM Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Getting (Map BufferRef FBuffer) Editor (Map BufferRef FBuffer)
    -> EditorM (Map BufferRef FBuffer)
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting (Map BufferRef FBuffer) Editor (Map BufferRef FBuffer)
    Lens' Editor (Map BufferRef FBuffer)
    buffersA
      unless fileBufOpen $
        void . newBufferE (MemBuffer "scratch") $ R.unlines
                [ "This buffer is for notes you don't want to save."
                , "If you want to create a file, open that file,"
                , "then enter the text in that file's own buffer."
                , ""
                ]
      where
        isFileOrDir :: FBuffer -> Bool
        isFileOrDir :: FBuffer -> Bool
    isFileOrDir FBuffer
    attrs = case FBuffer
    attrs FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
    forall s a. s -> Getting a s a -> a
    ^. Getting BufferId FBuffer BufferId
    forall c. HasAttributes c => Lens' c BufferId
    Lens' FBuffer BufferId
    identA of
          MemBuffer  Text
    _ -> FBuffer
    attrs FBuffer -> Getting Bool FBuffer Bool -> Bool
    forall s a. s -> Getting a s a -> a
    ^. Getting Bool FBuffer Bool
    forall c. HasAttributes c => Lens' c Bool
    Lens' FBuffer Bool
    directoryContentA
          FileBuffer String
    _ -> Bool
    True