{-# LANGUAGE RecordWildCards, ScopedTypeVariables, MultiParamTypeClasses
           , DeriveDataTypeable, OverloadedStrings
           , GeneralizedNewtypeDeriving, FlexibleContexts #-}

-- this module isn't finished, and there's heaps of warnings.
{-# OPTIONS_GHC -w #-}

-- |
-- Module      :  Yi.Frontend.Pango.Control
-- License     :  GPL

module Yi.Frontend.Pango.Control (
    Control(..)
  , ControlM(..)
  , Buffer(..)
  , View(..)
  , Iter(..)
  , startControl
  , runControl
  , controlIO
  , liftYi
  , getControl
  , newBuffer
  , newView
  , getBuffer
  , setBufferMode
  , withCurrentBuffer
  , setText
  , getText
  , keyTable
  ) where

import Data.Text (unpack, pack, Text)
import qualified Data.Text as T
import Prelude hiding (concatMap, concat, foldl, elem, mapM_)
import Control.Exception (catch)
import Control.Monad        hiding (mapM_, forM_)
import Control.Monad.Reader hiding (mapM_, forM_)
import Control.Applicative
import Lens.Micro.Platform hiding (views, Action)
import Data.Foldable
import Data.Maybe (maybe, fromJust, fromMaybe)
import Data.Monoid
import Data.IORef
import Data.List (nub, filter, drop, zip, take, length)
import Data.Prototype
import Yi.Rope (toText, splitAtLine, YiString)
import qualified Yi.Rope as R
import qualified Data.Map as Map
import Yi.Core (startEditor, focusAllSyntax)
import Yi.Buffer
import Yi.Config
import Yi.Tab
import Yi.Window as Yi
import Yi.Editor
import Yi.Event
import Yi.Keymap
import Yi.Monad
import Yi.Style
import Yi.UI.Utils
import Yi.Utils
import Yi.Debug
import Graphics.UI.Gtk as Gtk
       (Color(..), PangoRectangle(..), Rectangle(..), selectionDataSetText,
        targetString, clipboardSetWithData, clipboardRequestText,
        selectionPrimary, clipboardGetForDisplay, widgetGetDisplay,
        onMotionNotify, drawRectangle, drawLine,
        layoutIndexToPos, layoutGetCursorPos, drawLayout,
        widgetGetDrawWindow, layoutSetAttributes, widgetGrabFocus,
        scrolledWindowSetPolicy, scrolledWindowAddWithViewport,
        scrolledWindowNew, contextGetMetrics, contextGetLanguage,
        layoutSetFontDescription, layoutEmpty, widgetCreatePangoContext,
        widgetModifyBg, drawingAreaNew, FontDescription, ScrolledWindow,
        FontMetrics, Language, DrawingArea, layoutXYToIndex, layoutSetText,
        layoutGetText, widgetSetSizeRequest, layoutGetPixelExtents,
        layoutSetWidth, layoutGetWidth, layoutGetFontDescription,
        PangoLayout, descent, ascent, widgetGetSize, widgetQueueDraw,
        mainQuit, signalDisconnect, ConnectId(..), PolicyType(..),
        StateType(..), EventMask(..), AttrOp(..), Weight(..),
        PangoAttribute(..), Underline(..), FontStyle(..))
import Graphics.UI.Gtk.Gdk.GC as Gtk
  (newGCValues, gcSetValues, gcNew, foreground)
import qualified Graphics.UI.Gtk as Gtk
import qualified Graphics.UI.Gtk.Gdk.Events as Gdk.Events
import System.Glib.GError
import Control.Monad.Reader (ask, asks, MonadReader(..))
import Control.Monad.State (ap, get, put, modify)
import Control.Monad.Base
import Control.Concurrent (newMVar, modifyMVar, MVar, newEmptyMVar, putMVar,
                           readMVar, isEmptyMVar)
import Data.Typeable
import qualified Data.List.PointedList as PL (insertRight, withFocus,
                                              PointedList(..), singleton)
import Yi.Regex ((=~), AllTextSubmatches(..))
import Yi.String (showT)
import System.FilePath
import qualified Yi.UI.Common as Common

data Control = Control
    { Control -> Yi
controlYi :: Yi
    , Control -> IORef [TabInfo]
tabCache  :: IORef [TabInfo]
    , Control -> IORef (Map WindowRef View)
views     :: IORef (Map.Map WindowRef View)
    }
--    { config  :: Config
--    , editor  :: Editor
--    , input   :: Event -> IO ()
--    , output  :: Action -> IO ()
--    }

data TabInfo = TabInfo
    { TabInfo -> Tab
coreTab     :: Tab
--    , page        :: VBox
    }

instance Show TabInfo where
    show :: TabInfo -> String
show t :: TabInfo
t = Tab -> String
forall a. Show a => a -> String
show (TabInfo -> Tab
coreTab TabInfo
t)

--type ControlM = YiM
newtype ControlM a = ControlM { ControlM a -> ReaderT Control IO a
runControl'' :: ReaderT Control IO a }
    deriving (Applicative ControlM
a -> ControlM a
Applicative ControlM =>
(forall a b. ControlM a -> (a -> ControlM b) -> ControlM b)
-> (forall a b. ControlM a -> ControlM b -> ControlM b)
-> (forall a. a -> ControlM a)
-> Monad ControlM
ControlM a -> (a -> ControlM b) -> ControlM b
ControlM a -> ControlM b -> ControlM b
forall a. a -> ControlM a
forall a b. ControlM a -> ControlM b -> ControlM b
forall a b. ControlM a -> (a -> ControlM b) -> ControlM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ControlM a
$creturn :: forall a. a -> ControlM a
>> :: ControlM a -> ControlM b -> ControlM b
$c>> :: forall a b. ControlM a -> ControlM b -> ControlM b
>>= :: ControlM a -> (a -> ControlM b) -> ControlM b
$c>>= :: forall a b. ControlM a -> (a -> ControlM b) -> ControlM b
$cp1Monad :: Applicative ControlM
Monad, MonadBase IO, MonadReader Control, Typeable,
              a -> ControlM b -> ControlM a
(a -> b) -> ControlM a -> ControlM b
(forall a b. (a -> b) -> ControlM a -> ControlM b)
-> (forall a b. a -> ControlM b -> ControlM a) -> Functor ControlM
forall a b. a -> ControlM b -> ControlM a
forall a b. (a -> b) -> ControlM a -> ControlM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ControlM b -> ControlM a
$c<$ :: forall a b. a -> ControlM b -> ControlM a
fmap :: (a -> b) -> ControlM a -> ControlM b
$cfmap :: forall a b. (a -> b) -> ControlM a -> ControlM b
Functor, Functor ControlM
a -> ControlM a
Functor ControlM =>
(forall a. a -> ControlM a)
-> (forall a b. ControlM (a -> b) -> ControlM a -> ControlM b)
-> (forall a b c.
    (a -> b -> c) -> ControlM a -> ControlM b -> ControlM c)
-> (forall a b. ControlM a -> ControlM b -> ControlM b)
-> (forall a b. ControlM a -> ControlM b -> ControlM a)
-> Applicative ControlM
ControlM a -> ControlM b -> ControlM b
ControlM a -> ControlM b -> ControlM a
ControlM (a -> b) -> ControlM a -> ControlM b
(a -> b -> c) -> ControlM a -> ControlM b -> ControlM c
forall a. a -> ControlM a
forall a b. ControlM a -> ControlM b -> ControlM a
forall a b. ControlM a -> ControlM b -> ControlM b
forall a b. ControlM (a -> b) -> ControlM a -> ControlM b
forall a b c.
(a -> b -> c) -> ControlM a -> ControlM b -> ControlM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ControlM a -> ControlM b -> ControlM a
$c<* :: forall a b. ControlM a -> ControlM b -> ControlM a
*> :: ControlM a -> ControlM b -> ControlM b
$c*> :: forall a b. ControlM a -> ControlM b -> ControlM b
liftA2 :: (a -> b -> c) -> ControlM a -> ControlM b -> ControlM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ControlM a -> ControlM b -> ControlM c
<*> :: ControlM (a -> b) -> ControlM a -> ControlM b
$c<*> :: forall a b. ControlM (a -> b) -> ControlM a -> ControlM b
pure :: a -> ControlM a
$cpure :: forall a. a -> ControlM a
$cp1Applicative :: Functor ControlM
Applicative)

-- Helper functions to avoid issues with mismatching monad libraries
controlIO :: IO a -> ControlM a
controlIO :: IO a -> ControlM a
controlIO = IO a -> ControlM a
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

getControl :: ControlM Control
getControl :: ControlM Control
getControl = ControlM Control
forall r (m :: * -> *). MonadReader r m => m r
ask

liftYi :: YiM a -> ControlM a
liftYi :: YiM a -> ControlM a
liftYi m :: YiM a
m = do
    Yi
yi <- (Control -> Yi) -> ControlM Yi
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> Yi
controlYi
    IO a -> ControlM a
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO a -> ControlM a) -> IO a -> ControlM a
forall a b. (a -> b) -> a -> b
$ ReaderT Yi IO a -> Yi -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (YiM a -> ReaderT Yi IO a
forall a. YiM a -> ReaderT Yi IO a
runYiM YiM a
m) Yi
yi

--instance MonadState Editor ControlM where
--    get = readRef =<< editor <$> ask
--    put v = flip modifyRef (const v) =<< editor <$> ask

--instance MonadEditor ControlM where
--    askCfg = config <$> ask
--    withEditor f = do
--      r <- asks editor
--      cfg <- asks config
--      liftBase $ controlUnsafeWithEditor cfg r f

startControl :: Config -> ControlM () -> IO ()
startControl :: Config -> ControlM () -> IO ()
startControl config :: Config
config main :: ControlM ()
main = Config -> Maybe Editor -> IO ()
startEditor (Config
config { startFrontEnd :: UIBoot
startFrontEnd = ControlM () -> UIBoot
start ControlM ()
main } ) Maybe Editor
forall a. Maybe a
Nothing

runControl' :: ControlM a -> MVar Control -> IO (Maybe a)
runControl' :: ControlM a -> MVar Control -> IO (Maybe a)
runControl' m :: ControlM a
m yiMVar :: MVar Control
yiMVar = do
    Bool
empty <- MVar Control -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar Control
yiMVar
    if Bool
empty
        then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        else do
            Control
yi <- MVar Control -> IO Control
forall a. MVar a -> IO a
readMVar MVar Control
yiMVar
            a
result <- ControlM a -> Control -> IO a
forall a. ControlM a -> Control -> IO a
runControl ControlM a
m Control
yi
            Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
result

-- runControl :: ControlM a -> Yi -> IO a
-- runControl m yi = runReaderT (runYiM m) yi

runControl :: ControlM a -> Control -> IO a
runControl :: ControlM a -> Control -> IO a
runControl f :: ControlM a
f = ReaderT Control IO a -> Control -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ControlM a -> ReaderT Control IO a
forall a. ControlM a -> ReaderT Control IO a
runControl'' ControlM a
f)

-- runControlEditor f yiMVar = yiMVar

runAction :: Action -> ControlM ()
runAction :: Action -> ControlM ()
runAction action :: Action
action = do
    IsRefreshNeeded -> [Action] -> IO ()
out <- YiM (IsRefreshNeeded -> [Action] -> IO ())
-> ControlM (IsRefreshNeeded -> [Action] -> IO ())
forall a. YiM a -> ControlM a
liftYi (YiM (IsRefreshNeeded -> [Action] -> IO ())
 -> ControlM (IsRefreshNeeded -> [Action] -> IO ()))
-> YiM (IsRefreshNeeded -> [Action] -> IO ())
-> ControlM (IsRefreshNeeded -> [Action] -> IO ())
forall a b. (a -> b) -> a -> b
$ (Yi -> IsRefreshNeeded -> [Action] -> IO ())
-> YiM (IsRefreshNeeded -> [Action] -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Yi -> IsRefreshNeeded -> [Action] -> IO ()
yiOutput
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ IsRefreshNeeded -> [Action] -> IO ()
out IsRefreshNeeded
MustRefresh [Action
action]

-- | Test 2
mkUI :: IO () -> MVar Control -> Common.UI Editor
mkUI :: IO () -> MVar Control -> UI Editor
mkUI main :: IO ()
main yiMVar :: MVar Control
yiMVar = UI Any
forall e. UI e
Common.dummyUI
    { main :: IO ()
Common.main          = IO ()
main
    , end :: Maybe ExitCode -> IO ()
Common.end           = \_ -> IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ControlM () -> MVar Control -> IO (Maybe ())
forall a. ControlM a -> MVar Control -> IO (Maybe a)
runControl' ControlM ()
end MVar Control
yiMVar
    , suspend :: IO ()
Common.suspend       = IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ControlM () -> MVar Control -> IO (Maybe ())
forall a. ControlM a -> MVar Control -> IO (Maybe a)
runControl' ControlM ()
suspend MVar Control
yiMVar
    , refresh :: Editor -> IO ()
Common.refresh       = \e :: Editor
e -> IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ControlM () -> MVar Control -> IO (Maybe ())
forall a. ControlM a -> MVar Control -> IO (Maybe a)
runControl' (Editor -> ControlM ()
refresh Editor
e) MVar Control
yiMVar
    , layout :: Editor -> IO Editor
Common.layout        = \e :: Editor
e -> (Maybe Editor -> Editor) -> IO (Maybe Editor) -> IO Editor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Editor -> Maybe Editor -> Editor
forall a. a -> Maybe a -> a
fromMaybe Editor
e) (IO (Maybe Editor) -> IO Editor) -> IO (Maybe Editor) -> IO Editor
forall a b. (a -> b) -> a -> b
$
                                   ControlM Editor -> MVar Control -> IO (Maybe Editor)
forall a. ControlM a -> MVar Control -> IO (Maybe a)
runControl' (Editor -> ControlM Editor
doLayout Editor
e) MVar Control
yiMVar
    , reloadProject :: String -> IO ()
Common.reloadProject = \f :: String
f -> IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ControlM () -> MVar Control -> IO (Maybe ())
forall a. ControlM a -> MVar Control -> IO (Maybe a)
runControl' (String -> ControlM ()
reloadProject String
f) MVar Control
yiMVar
    }

start :: ControlM () -> UIBoot
start :: ControlM () -> UIBoot
start main :: ControlM ()
main cfg :: Config
cfg ch :: [Event] -> IO ()
ch outCh :: [Action] -> IO ()
outCh ed :: Editor
ed =
  IO (UI Editor) -> (GError -> IO (UI Editor)) -> IO (UI Editor)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (ControlM () -> UIBoot
startNoMsg ControlM ()
main Config
cfg [Event] -> IO ()
ch [Action] -> IO ()
outCh Editor
ed) (\(GError _dom :: GErrorDomain
_dom _code :: Int
_code msg :: GErrorMessage
msg) ->
                                            String -> IO (UI Editor)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (UI Editor)) -> String -> IO (UI Editor)
forall a b. (a -> b) -> a -> b
$ GErrorMessage -> String
unpack GErrorMessage
msg)

makeControl :: MVar Control -> YiM ()
makeControl :: MVar Control -> YiM ()
makeControl controlMVar :: MVar Control
controlMVar = do
    Yi
controlYi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
    IORef [TabInfo]
tabCache  <- IO (IORef [TabInfo]) -> YiM (IORef [TabInfo])
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (IORef [TabInfo]) -> YiM (IORef [TabInfo]))
-> IO (IORef [TabInfo]) -> YiM (IORef [TabInfo])
forall a b. (a -> b) -> a -> b
$ [TabInfo] -> IO (IORef [TabInfo])
forall a. a -> IO (IORef a)
newIORef []
    IORef (Map WindowRef View)
views  <- IO (IORef (Map WindowRef View)) -> YiM (IORef (Map WindowRef View))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (IORef (Map WindowRef View))
 -> YiM (IORef (Map WindowRef View)))
-> IO (IORef (Map WindowRef View))
-> YiM (IORef (Map WindowRef View))
forall a b. (a -> b) -> a -> b
$ Map WindowRef View -> IO (IORef (Map WindowRef View))
forall a. a -> IO (IORef a)
newIORef Map WindowRef View
forall k a. Map k a
Map.empty
    IO () -> YiM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ MVar Control -> Control -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Control
controlMVar Control :: Yi -> IORef [TabInfo] -> IORef (Map WindowRef View) -> Control
Control{..}

startNoMsg :: ControlM () -> UIBoot
startNoMsg :: ControlM () -> UIBoot
startNoMsg main :: ControlM ()
main config :: Config
config input :: [Event] -> IO ()
input output :: [Action] -> IO ()
output ed :: Editor
ed = do
    MVar Control
control <- IO (MVar Control)
forall a. IO (MVar a)
newEmptyMVar
    let wrappedMain :: IO ()
wrappedMain = do
          [Action] -> IO ()
output [YiM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction (YiM () -> Action) -> YiM () -> Action
forall a b. (a -> b) -> a -> b
$ MVar Control -> YiM ()
makeControl MVar Control
control]
          IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ControlM () -> MVar Control -> IO (Maybe ())
forall a. ControlM a -> MVar Control -> IO (Maybe a)
runControl' ControlM ()
main MVar Control
control)
    UI Editor -> IO (UI Editor)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> MVar Control -> UI Editor
mkUI IO ()
wrappedMain MVar Control
control)

end :: ControlM ()
end :: ControlM ()
end = do
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "Yi Control End"
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO ()
mainQuit

suspend :: ControlM ()
suspend :: ControlM ()
suspend = do
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "Yi Control Suspend"
    () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# ANN refresh ("HLint: ignore Redundant do" :: String) #-}
refresh :: Editor -> ControlM ()
refresh :: Editor -> ControlM ()
refresh e :: Editor
e = do
    --contextId <- statusbarGetContextId (uiStatusbar ui) "global"
    --statusbarPop  (uiStatusbar ui) contextId
    --statusbarPush (uiStatusbar ui) contextId $ intercalate "  " $ statusLine e

    Editor -> ControlM ()
updateCache Editor
e -- The cursor may have changed since doLayout
    IORef (Map WindowRef View)
viewsRef <- (Control -> IORef (Map WindowRef View))
-> ControlM (IORef (Map WindowRef View))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> IORef (Map WindowRef View)
views
    Map WindowRef View
vs <- IO (Map WindowRef View) -> ControlM (Map WindowRef View)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Map WindowRef View) -> ControlM (Map WindowRef View))
-> IO (Map WindowRef View) -> ControlM (Map WindowRef View)
forall a b. (a -> b) -> a -> b
$ IORef (Map WindowRef View) -> IO (Map WindowRef View)
forall a. IORef a -> IO a
readIORef IORef (Map WindowRef View)
viewsRef
    [View] -> (View -> ControlM ()) -> ControlM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map WindowRef View -> [View]
forall k a. Map k a -> [a]
Map.elems Map WindowRef View
vs) ((View -> ControlM ()) -> ControlM ())
-> (View -> ControlM ()) -> ControlM ()
forall a b. (a -> b) -> a -> b
$ \v :: View
v -> do
        let b :: FBuffer
b = BufferRef -> Editor -> FBuffer
findBufferWith (View -> BufferRef
viewFBufRef View
v) Editor
e
        -- when (not $ null $ b ^. pendingUpdatesA) $
        do
            -- sig <- readIORef (renderer w)
            -- signalDisconnect sig
            -- writeRef (renderer w)
            -- =<< (textview w `onExpose` render e ui b (wkey (coreWin w)))
            IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw (View -> DrawingArea
drawArea View
v)

doLayout :: Editor -> ControlM Editor
doLayout :: Editor -> ControlM Editor
doLayout e :: Editor
e = do
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "Yi Control Do Layout"
    Editor -> ControlM ()
updateCache Editor
e
    IORef [TabInfo]
cacheRef <- (Control -> IORef [TabInfo]) -> ControlM (IORef [TabInfo])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> IORef [TabInfo]
tabCache
    [TabInfo]
tabs <- IO [TabInfo] -> ControlM [TabInfo]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [TabInfo] -> ControlM [TabInfo])
-> IO [TabInfo] -> ControlM [TabInfo]
forall a b. (a -> b) -> a -> b
$ IORef [TabInfo] -> IO [TabInfo]
forall a. IORef a -> IO a
readIORef IORef [TabInfo]
cacheRef
    [(WindowRef, Int, Int, Region)]
dims <- [[(WindowRef, Int, Int, Region)]]
-> [(WindowRef, Int, Int, Region)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(WindowRef, Int, Int, Region)]]
 -> [(WindowRef, Int, Int, Region)])
-> ControlM [[(WindowRef, Int, Int, Region)]]
-> ControlM [(WindowRef, Int, Int, Region)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TabInfo -> ControlM [(WindowRef, Int, Int, Region)])
-> [TabInfo] -> ControlM [[(WindowRef, Int, Int, Region)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Editor -> TabInfo -> ControlM [(WindowRef, Int, Int, Region)]
getDimensionsInTab Editor
e) [TabInfo]
tabs
    let e' :: Editor
e' = ((PointedList Tab -> Identity (PointedList Tab))
-> Editor -> Identity Editor
Lens' Editor (PointedList Tab)
tabsA ((PointedList Tab -> Identity (PointedList Tab))
 -> Editor -> Identity Editor)
-> (PointedList Tab -> PointedList Tab) -> Editor -> Editor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Tab -> Tab) -> PointedList Tab -> PointedList Tab
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Window -> Window) -> Tab -> Tab
mapWindows Window -> Window
updateWin)) Editor
e
        updateWin :: Window -> Window
updateWin w :: Window
w = case ((WindowRef, Int, Int, Region) -> Bool)
-> [(WindowRef, Int, Int, Region)]
-> Maybe (WindowRef, Int, Int, Region)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ref :: WindowRef
ref,_,_,_) -> (Window -> WindowRef
wkey Window
w WindowRef -> WindowRef -> Bool
forall a. Eq a => a -> a -> Bool
== WindowRef
ref)) [(WindowRef, Int, Int, Region)]
dims of
                          Nothing -> Window
w
                          Just (_, wi :: Int
wi, h :: Int
h,rgn :: Region
rgn) -> Window
w { width :: Int
width = Int
wi
                                                   , height :: Int
height = Int
h
                                                   , winRegion :: Region
winRegion = Region
rgn }
    -- Don't leak references to old Windows
    let forceWin :: p -> Window -> p
forceWin x :: p
x w :: Window
w = Window -> Int
height Window
w Int -> p -> p
forall a b. a -> b -> b
`seq` Window -> Region
winRegion Window
w Region -> p -> p
forall a b. a -> b -> b
`seq` p
x
    Editor -> ControlM Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> ControlM Editor) -> Editor -> ControlM Editor
forall a b. (a -> b) -> a -> b
$ ((Editor -> Tab -> Editor) -> Editor -> PointedList Tab -> Editor
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Editor -> Tab -> Editor) -> Editor -> PointedList Tab -> Editor)
-> ((Editor -> Window -> Editor) -> Editor -> Tab -> Editor)
-> (Editor -> Window -> Editor)
-> Editor
-> PointedList Tab
-> Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor -> Window -> Editor) -> Editor -> Tab -> Editor
forall a. (a -> Window -> a) -> a -> Tab -> a
tabFoldl) Editor -> Window -> Editor
forall p. p -> Window -> p
forceWin Editor
e' (Editor
e' Editor
-> Getting (PointedList Tab) Editor (PointedList Tab)
-> PointedList Tab
forall s a. s -> Getting a s a -> a
^. Getting (PointedList Tab) Editor (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA)

-- | Width, Height
getDimensionsInTab :: Editor -> TabInfo -> ControlM [(WindowRef,Int,Int,Region)]
getDimensionsInTab :: Editor -> TabInfo -> ControlM [(WindowRef, Int, Int, Region)]
getDimensionsInTab e :: Editor
e tab :: TabInfo
tab = do
  IORef (Map WindowRef View)
viewsRef <- (Control -> IORef (Map WindowRef View))
-> ControlM (IORef (Map WindowRef View))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> IORef (Map WindowRef View)
views
  Map WindowRef View
vs <- IO (Map WindowRef View) -> ControlM (Map WindowRef View)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Map WindowRef View) -> ControlM (Map WindowRef View))
-> IO (Map WindowRef View) -> ControlM (Map WindowRef View)
forall a b. (a -> b) -> a -> b
$ IORef (Map WindowRef View) -> IO (Map WindowRef View)
forall a. IORef a -> IO a
readIORef IORef (Map WindowRef View)
viewsRef
  ([(WindowRef, Int, Int, Region)]
 -> Window -> ControlM [(WindowRef, Int, Int, Region)])
-> [(WindowRef, Int, Int, Region)]
-> PointedList Window
-> ControlM [(WindowRef, Int, Int, Region)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\a :: [(WindowRef, Int, Int, Region)]
a w :: Window
w ->
        case WindowRef -> Map WindowRef View -> Maybe View
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Window -> WindowRef
wkey Window
w) Map WindowRef View
vs of
            Just v :: View
v -> do
                (wi :: Int
wi, h :: Int
h) <- IO (Int, Int) -> ControlM (Int, Int)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Int, Int) -> ControlM (Int, Int))
-> IO (Int, Int) -> ControlM (Int, Int)
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO (Int, Int)
forall widget. WidgetClass widget => widget -> IO (Int, Int)
widgetGetSize (DrawingArea -> IO (Int, Int)) -> DrawingArea -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ View -> DrawingArea
drawArea View
v
                let lineHeight :: Double
lineHeight = FontMetrics -> Double
ascent (View -> FontMetrics
metrics View
v) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FontMetrics -> Double
descent (View -> FontMetrics
metrics View
v)
                    charWidth :: Double
charWidth = FontMetrics -> Double
Gtk.approximateCharWidth (FontMetrics -> Double) -> FontMetrics -> Double
forall a b. (a -> b) -> a -> b
$ View -> FontMetrics
metrics View
v
                    b0 :: FBuffer
b0 = BufferRef -> Editor -> FBuffer
findBufferWith (View -> BufferRef
viewFBufRef View
v) Editor
e
                Region
rgn <- Editor -> View -> FBuffer -> ControlM Region
shownRegion Editor
e View
v FBuffer
b0
                let ret :: (WindowRef, Int, Int, Region)
ret= (View -> WindowRef
windowRef View
v, Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
charWidth, 
                          Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
lineHeight, Region
rgn)
                [(WindowRef, Int, Int, Region)]
-> ControlM [(WindowRef, Int, Int, Region)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(WindowRef, Int, Int, Region)]
 -> ControlM [(WindowRef, Int, Int, Region)])
-> [(WindowRef, Int, Int, Region)]
-> ControlM [(WindowRef, Int, Int, Region)]
forall a b. (a -> b) -> a -> b
$ [(WindowRef, Int, Int, Region)]
a [(WindowRef, Int, Int, Region)]
-> [(WindowRef, Int, Int, Region)]
-> [(WindowRef, Int, Int, Region)]
forall a. Semigroup a => a -> a -> a
<> [(WindowRef, Int, Int, Region)
ret]
            Nothing -> [(WindowRef, Int, Int, Region)]
-> ControlM [(WindowRef, Int, Int, Region)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(WindowRef, Int, Int, Region)]
a)
      [] (TabInfo -> Tab
coreTab TabInfo
tab Tab
-> Getting (PointedList Window) Tab (PointedList Window)
-> PointedList Window
forall s a. s -> Getting a s a -> a
^. Getting (PointedList Window) Tab (PointedList Window)
forall (f :: * -> *).
Functor f =>
(PointedList Window -> f (PointedList Window)) -> Tab -> f Tab
tabWindowsA)

shownRegion :: Editor -> View -> FBuffer -> ControlM Region
shownRegion :: Editor -> View -> FBuffer -> ControlM Region
shownRegion e :: Editor
e v :: View
v b :: FBuffer
b = do
   (tos :: Point
tos, _, bos :: Point
bos) <- Editor
-> View -> FBuffer -> PangoLayout -> ControlM (Point, Point, Point)
updatePango Editor
e View
v FBuffer
b (View -> PangoLayout
layout View
v)
   Region -> ControlM Region
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> ControlM Region) -> Region -> ControlM Region
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
tos Point
bos

updatePango :: Editor -> View -> FBuffer -> PangoLayout
            -> ControlM (Point, Point, Point)
updatePango :: Editor
-> View -> FBuffer -> PangoLayout -> ControlM (Point, Point, Point)
updatePango e :: Editor
e v :: View
v b :: FBuffer
b layout :: PangoLayout
layout = do
  (width' :: Int
width', height' :: Int
height') <- IO (Int, Int) -> ControlM (Int, Int)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Int, Int) -> ControlM (Int, Int))
-> IO (Int, Int) -> ControlM (Int, Int)
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO (Int, Int)
forall widget. WidgetClass widget => widget -> IO (Int, Int)
widgetGetSize (DrawingArea -> IO (Int, Int)) -> DrawingArea -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ View -> DrawingArea
drawArea View
v

  Maybe FontDescription
font <- IO (Maybe FontDescription) -> ControlM (Maybe FontDescription)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Maybe FontDescription) -> ControlM (Maybe FontDescription))
-> IO (Maybe FontDescription) -> ControlM (Maybe FontDescription)
forall a b. (a -> b) -> a -> b
$ PangoLayout -> IO (Maybe FontDescription)
layoutGetFontDescription PangoLayout
layout

  --oldFont <- layoutGetFontDescription layout
  --oldFontStr <- maybe (return Nothing)
  --              (fmap Just . fontDescriptionToString) oldFont
  --newFontStr <- Just <$> fontDescriptionToString font
  --when (oldFontStr /= newFontStr)
  --  (layoutSetFontDescription layout (Just font))

  let win :: Window
win                 = WindowRef -> Editor -> Window
findWindowWith (View -> WindowRef
windowRef View
v) Editor
e
      [width'' :: Double
width'', height'' :: Double
height''] = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
width', Int
height']
      lineHeight :: Double
lineHeight          = FontMetrics -> Double
ascent (View -> FontMetrics
metrics View
v) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FontMetrics -> Double
descent (View -> FontMetrics
metrics View
v)
      winh :: Int
winh                = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
height'' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
lineHeight)

      (tos :: Point
tos, point :: Point
point, text :: GErrorMessage
text)  = Window
-> FBuffer
-> BufferM (Point, Point, GErrorMessage)
-> (Point, Point, GErrorMessage)
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
win FBuffer
b (BufferM (Point, Point, GErrorMessage)
 -> (Point, Point, GErrorMessage))
-> BufferM (Point, Point, GErrorMessage)
-> (Point, Point, GErrorMessage)
forall a b. (a -> b) -> a -> b
$ do
                              Point
from <- (Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> (Mark -> Getting Point FBuffer Point) -> Mark -> BufferM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Getting Point FBuffer Point
Mark -> Lens' FBuffer Point
markPointA) (Mark -> BufferM Point) -> BufferM Mark -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MarkSet Mark -> Mark
forall a. MarkSet a -> a
fromMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks
                              YiString
rope <- Direction -> Point -> BufferM YiString
streamB Direction
Forward Point
from
                              Point
p    <- BufferM Point
pointB
                              let content :: YiString
content = (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString, YiString) -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> YiString -> (YiString, YiString)
splitAtLine Int
winh YiString
rope
                              -- allow BOS offset to be just after the last line
                              let addNL :: YiString -> YiString
addNL = if YiString -> Int
R.countNewLines YiString
content Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
winh
                                          then YiString -> YiString
forall a. a -> a
id
                                          else (YiString -> Char -> YiString
`R.snoc` '\n')
                              (Point, Point, GErrorMessage)
-> BufferM (Point, Point, GErrorMessage)
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
from, Point
p, YiString -> GErrorMessage
R.toText (YiString -> GErrorMessage) -> YiString -> GErrorMessage
forall a b. (a -> b) -> a -> b
$ YiString -> YiString
addNL YiString
content)

  Config
config   <- YiM Config -> ControlM Config
forall a. YiM a -> ControlM a
liftYi YiM Config
forall (m :: * -> *). MonadEditor m => m Config
askCfg
  if UIConfig -> Bool
configLineWrap (UIConfig -> Bool) -> UIConfig -> Bool
forall a b. (a -> b) -> a -> b
$ Config -> UIConfig
configUI Config
config
    then do Maybe Double
oldWidth <- IO (Maybe Double) -> ControlM (Maybe Double)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Maybe Double) -> ControlM (Maybe Double))
-> IO (Maybe Double) -> ControlM (Maybe Double)
forall a b. (a -> b) -> a -> b
$ PangoLayout -> IO (Maybe Double)
layoutGetWidth PangoLayout
layout
            Bool -> ControlM () -> ControlM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Double
oldWidth Maybe Double -> Maybe Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Maybe Double
forall a. a -> Maybe a
Just Double
width'') (ControlM () -> ControlM ()) -> ControlM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$
              IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ PangoLayout -> Maybe Double -> IO ()
layoutSetWidth PangoLayout
layout (Maybe Double -> IO ()) -> Maybe Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
width''
    else do
    (Rectangle px :: Int
px _py :: Int
_py pwidth :: Int
pwidth _pheight :: Int
_pheight, _) <- IO (Rectangle, Rectangle) -> ControlM (Rectangle, Rectangle)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Rectangle, Rectangle) -> ControlM (Rectangle, Rectangle))
-> IO (Rectangle, Rectangle) -> ControlM (Rectangle, Rectangle)
forall a b. (a -> b) -> a -> b
$
                                             PangoLayout -> IO (Rectangle, Rectangle)
layoutGetPixelExtents PangoLayout
layout
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> Int -> Int -> IO ()
forall self. WidgetClass self => self -> Int -> Int -> IO ()
widgetSetSizeRequest (View -> DrawingArea
drawArea View
v) (Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pwidth) (-1)

  -- optimize for cursor movement
  GErrorMessage
oldText <- IO GErrorMessage -> ControlM GErrorMessage
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO GErrorMessage -> ControlM GErrorMessage)
-> IO GErrorMessage -> ControlM GErrorMessage
forall a b. (a -> b) -> a -> b
$ PangoLayout -> IO GErrorMessage
forall string. GlibString string => PangoLayout -> IO string
layoutGetText PangoLayout
layout
  Bool -> ControlM () -> ControlM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GErrorMessage
oldText GErrorMessage -> GErrorMessage -> Bool
forall a. Eq a => a -> a -> Bool
/= GErrorMessage
text) (ControlM () -> ControlM ()) -> ControlM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ PangoLayout -> GErrorMessage -> IO ()
forall string. GlibString string => PangoLayout -> string -> IO ()
layoutSetText PangoLayout
layout GErrorMessage
text

  (_, bosOffset :: Int
bosOffset, _) <- IO (Bool, Int, Int) -> ControlM (Bool, Int, Int)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Bool, Int, Int) -> ControlM (Bool, Int, Int))
-> IO (Bool, Int, Int) -> ControlM (Bool, Int, Int)
forall a b. (a -> b) -> a -> b
$ PangoLayout -> Double -> Double -> IO (Bool, Int, Int)
layoutXYToIndex PangoLayout
layout Double
width''
                       (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
winh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
lineHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- 1)
  (Point, Point, Point) -> ControlM (Point, Point, Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
tos, Point
point, Point
tos Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int -> Point
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bosOffset Point -> Point -> Point
forall a. Num a => a -> a -> a
+ 1)

updateCache :: Editor -> ControlM ()
updateCache :: Editor -> ControlM ()
updateCache e :: Editor
e = do
    let tabs :: PointedList Tab
tabs = Editor
e Editor
-> Getting (PointedList Tab) Editor (PointedList Tab)
-> PointedList Tab
forall s a. s -> Getting a s a -> a
^. Getting (PointedList Tab) Editor (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA
    IORef [TabInfo]
cacheRef <- (Control -> IORef [TabInfo]) -> ControlM (IORef [TabInfo])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> IORef [TabInfo]
tabCache
    [TabInfo]
cache <- IO [TabInfo] -> ControlM [TabInfo]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [TabInfo] -> ControlM [TabInfo])
-> IO [TabInfo] -> ControlM [TabInfo]
forall a b. (a -> b) -> a -> b
$ IORef [TabInfo] -> IO [TabInfo]
forall a. IORef a -> IO a
readIORef IORef [TabInfo]
cacheRef
    [TabInfo]
cache' <- Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]
syncTabs Editor
e (PointedList (Tab, Bool) -> [(Tab, Bool)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PointedList (Tab, Bool) -> [(Tab, Bool)])
-> PointedList (Tab, Bool) -> [(Tab, Bool)]
forall a b. (a -> b) -> a -> b
$ PointedList Tab -> PointedList (Tab, Bool)
forall a. PointedList a -> PointedList (a, Bool)
PL.withFocus PointedList Tab
tabs) [TabInfo]
cache
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ IORef [TabInfo] -> [TabInfo] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [TabInfo]
cacheRef [TabInfo]
cache'

syncTabs :: Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]
syncTabs :: Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]
syncTabs e :: Editor
e (tfocused :: (Tab, Bool)
tfocused@(t :: Tab
t,focused :: Bool
focused):ts :: [(Tab, Bool)]
ts) (c :: TabInfo
c:cs :: [TabInfo]
cs)
    | Tab
t Tab -> Tab -> Bool
forall a. Eq a => a -> a -> Bool
== TabInfo -> Tab
coreTab TabInfo
c =
        do Bool -> ControlM () -> ControlM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
focused (ControlM () -> ControlM ()) -> ControlM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ TabInfo -> ControlM ()
setTabFocus TabInfo
c
--           let vCache = views c
           (:) (TabInfo -> [TabInfo] -> [TabInfo])
-> ControlM TabInfo -> ControlM ([TabInfo] -> [TabInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor -> TabInfo -> Tab -> ControlM TabInfo
syncTab Editor
e TabInfo
c Tab
t ControlM ([TabInfo] -> [TabInfo])
-> ControlM [TabInfo] -> ControlM [TabInfo]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]
syncTabs Editor
e [(Tab, Bool)]
ts [TabInfo]
cs
    | Tab
t Tab -> [Tab] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TabInfo -> Tab) -> [TabInfo] -> [Tab]
forall a b. (a -> b) -> [a] -> [b]
map TabInfo -> Tab
coreTab [TabInfo]
cs =
        do TabInfo -> ControlM ()
removeTab TabInfo
c
           Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]
syncTabs Editor
e ((Tab, Bool)
tfocused(Tab, Bool) -> [(Tab, Bool)] -> [(Tab, Bool)]
forall a. a -> [a] -> [a]
:[(Tab, Bool)]
ts) [TabInfo]
cs
    | Bool
otherwise =
        do TabInfo
c' <- Editor -> Tab -> TabInfo -> ControlM TabInfo
insertTabBefore Editor
e Tab
t TabInfo
c
           Bool -> ControlM () -> ControlM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
focused (ControlM () -> ControlM ()) -> ControlM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ TabInfo -> ControlM ()
setTabFocus TabInfo
c'
           ([TabInfo] -> [TabInfo]) -> ControlM ([TabInfo] -> [TabInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (TabInfo
c'TabInfo -> [TabInfo] -> [TabInfo]
forall a. a -> [a] -> [a]
:) ControlM ([TabInfo] -> [TabInfo])
-> ControlM [TabInfo] -> ControlM [TabInfo]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]
syncTabs Editor
e [(Tab, Bool)]
ts (TabInfo
cTabInfo -> [TabInfo] -> [TabInfo]
forall a. a -> [a] -> [a]
:[TabInfo]
cs)
syncTabs e :: Editor
e ts :: [(Tab, Bool)]
ts [] = ((Tab, Bool) -> ControlM TabInfo)
-> [(Tab, Bool)] -> ControlM [TabInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(t :: Tab
t,focused :: Bool
focused) -> do
        TabInfo
c' <- Editor -> Tab -> ControlM TabInfo
insertTab Editor
e Tab
t
        Bool -> ControlM () -> ControlM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
focused (ControlM () -> ControlM ()) -> ControlM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ TabInfo -> ControlM ()
setTabFocus TabInfo
c'
        TabInfo -> ControlM TabInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TabInfo
c') [(Tab, Bool)]
ts
syncTabs _ [] cs :: [TabInfo]
cs = (TabInfo -> ControlM ()) -> [TabInfo] -> ControlM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TabInfo -> ControlM ()
removeTab [TabInfo]
cs ControlM () -> ControlM [TabInfo] -> ControlM [TabInfo]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TabInfo] -> ControlM [TabInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return []

syncTab :: Editor -> TabInfo -> Tab -> ControlM TabInfo
syncTab :: Editor -> TabInfo -> Tab -> ControlM TabInfo
syncTab e :: Editor
e tab :: TabInfo
tab ws :: Tab
ws =
  -- TODO Maybe do something here
  TabInfo -> ControlM TabInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TabInfo
tab

setTabFocus :: TabInfo -> ControlM ()
setTabFocus :: TabInfo -> ControlM ()
setTabFocus t :: TabInfo
t =
  -- TODO this needs to set the tab focus with callback
  -- but only if the tab focus has changed
  () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

askBuffer :: Yi.Window -> FBuffer -> BufferM a -> a
askBuffer :: Window -> FBuffer -> BufferM a -> a
askBuffer w :: Window
w b :: FBuffer
b f :: BufferM a
f = (a, FBuffer) -> a
forall a b. (a, b) -> a
fst ((a, FBuffer) -> a) -> (a, FBuffer) -> a
forall a b. (a -> b) -> a -> b
$ Window -> FBuffer -> BufferM a -> (a, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
w FBuffer
b BufferM a
f

setWindowFocus :: Editor -> TabInfo -> View -> ControlM ()
setWindowFocus :: Editor -> TabInfo -> View -> ControlM ()
setWindowFocus e :: Editor
e t :: TabInfo
t v :: View
v = do
  let bufferName :: GErrorMessage
bufferName = Int -> FBuffer -> GErrorMessage
shortIdentString ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ Editor -> [String]
commonNamePrefix Editor
e) (FBuffer -> GErrorMessage) -> FBuffer -> GErrorMessage
forall a b. (a -> b) -> a -> b
$
                   BufferRef -> Editor -> FBuffer
findBufferWith (View -> BufferRef
viewFBufRef View
v) Editor
e
      window :: Window
window = WindowRef -> Editor -> Window
findWindowWith (View -> WindowRef
windowRef View
v) Editor
e
      ml :: GErrorMessage
ml = Window -> FBuffer -> BufferM GErrorMessage -> GErrorMessage
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
window (BufferRef -> Editor -> FBuffer
findBufferWith (View -> BufferRef
viewFBufRef View
v) Editor
e) (BufferM GErrorMessage -> GErrorMessage)
-> BufferM GErrorMessage -> GErrorMessage
forall a b. (a -> b) -> a -> b
$
           [GErrorMessage] -> BufferM GErrorMessage
getModeLine (String -> GErrorMessage
T.pack (String -> GErrorMessage) -> [String] -> [GErrorMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor -> [String]
commonNamePrefix Editor
e)

-- TODO
--  update (textview w) widgetIsFocus True
--  update (modeline w) labelText ml
--  update (uiWindow ui) windowTitle $ bufferName <> " - Yi"
--  update (uiNotebook ui) (notebookChildTabLabel (page t))
--    (tabAbbrevTitle bufferName)
  () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

removeTab :: TabInfo -> ControlM ()
removeTab :: TabInfo -> ControlM ()
removeTab t :: TabInfo
t =
  -- TODO this needs to close the views in the tab with callback
  () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

removeView :: TabInfo -> View -> ControlM ()
removeView :: TabInfo -> View -> ControlM ()
removeView tab :: TabInfo
tab view :: View
view =
  -- TODO this needs to close the view with callback
  () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Make a new tab.
newTab :: Editor -> Tab -> ControlM TabInfo
newTab :: Editor -> Tab -> ControlM TabInfo
newTab e :: Editor
e ws :: Tab
ws = do
    let t' :: TabInfo
t' = TabInfo :: Tab -> TabInfo
TabInfo { coreTab :: Tab
coreTab = Tab
ws }
--    cache <- syncWindows e t' (toList $ PL.withFocus ws) []
    TabInfo -> ControlM TabInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TabInfo
t' -- { views = cache }

{-# ANN insertTabBefore ("HLint: ignore Redundant do" :: String) #-}
insertTabBefore :: Editor -> Tab -> TabInfo -> ControlM TabInfo
insertTabBefore :: Editor -> Tab -> TabInfo -> ControlM TabInfo
insertTabBefore e :: Editor
e ws :: Tab
ws c :: TabInfo
c = do
    -- Just p <- notebookPageNum (uiNotebook ui) (page c)
    -- vb <- vBoxNew False 1
    -- notebookInsertPage (uiNotebook ui) vb "" p
    -- widgetShowAll $ vb
    Editor -> Tab -> ControlM TabInfo
newTab Editor
e Tab
ws

{-# ANN insertTab ("HLint: ignore Redundant do" :: String) #-}
insertTab :: Editor -> Tab -> ControlM TabInfo
insertTab :: Editor -> Tab -> ControlM TabInfo
insertTab e :: Editor
e ws :: Tab
ws = do
    -- vb <- vBoxNew False 1
    -- notebookAppendPage (uiNotebook ui) vb ""
    -- widgetShowAll $ vb
    Editor -> Tab -> ControlM TabInfo
newTab Editor
e Tab
ws

{-
insertWindowBefore :: Editor -> TabInfo -> Yi.Window -> WinInfo -> IO WinInfo
insertWindowBefore e ui tab w _c = insertWindow e ui tab w

insertWindowAtEnd :: Editor -> UI -> TabInfo -> Window -> IO WinInfo
insertWindowAtEnd e ui tab w = insertWindow e ui tab w

insertWindow :: Editor -> UI -> TabInfo -> Window -> IO WinInfo
insertWindow e ui tab win = do
  let buf = findBufferWith (bufkey win) e
  liftBase $ do w <- newWindow e ui win buf

              set (page tab) $
                [ containerChild := widget w
                , boxChildPacking (widget w) :=
                    if isMini (coreWin w)
                        then PackNatural
                        else PackGrow
                ]

              let ref = (wkey . coreWin) w
              textview w `onButtonRelease` handleClick ui ref
              textview w `onButtonPress` handleClick ui ref
              textview w `onScroll` handleScroll ui ref
              textview w `onConfigure` handleConfigure ui ref
              widgetShowAll (widget w)

              return w
-}

reloadProject :: FilePath -> ControlM ()
reloadProject :: String -> ControlM ()
reloadProject _ = () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

controlUnsafeWithEditor :: Config -> MVar Editor -> EditorM a -> IO a
controlUnsafeWithEditor :: Config -> MVar Editor -> EditorM a -> IO a
controlUnsafeWithEditor cfg :: Config
cfg r :: MVar Editor
r f :: EditorM a
f = MVar Editor -> (Editor -> IO (Editor, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar Editor
r ((Editor -> IO (Editor, a)) -> IO a)
-> (Editor -> IO (Editor, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \e :: Editor
e -> do
  let (e' :: Editor
e',a :: a
a) = Config -> EditorM a -> Editor -> (Editor, a)
forall a. Config -> EditorM a -> Editor -> (Editor, a)
runEditor Config
cfg EditorM a
f Editor
e
  -- Make sure that the result of runEditor is evaluated before
  -- replacing the editor state. Otherwise, we might replace e
  -- with an exception-producing thunk, which makes it impossible
  -- to look at or update the editor state.
  -- Maybe this could also be fixed by -fno-state-hack flag?
  -- TODO: can we simplify this?
  Editor
e' Editor -> IO (Editor, a) -> IO (Editor, a)
forall a b. a -> b -> b
`seq` a
a a -> IO (Editor, a) -> IO (Editor, a)
forall a b. a -> b -> b
`seq` (Editor, a) -> IO (Editor, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor
e', a
a)

data Buffer = Buffer
    { Buffer -> BufferRef
fBufRef     :: BufferRef
    }

data View = View
    { View -> BufferRef
viewFBufRef :: BufferRef
    , View -> WindowRef
windowRef   :: WindowRef
    , View -> DrawingArea
drawArea    :: DrawingArea
    , View -> PangoLayout
layout      :: PangoLayout
    , View -> Language
language    :: Language
    , View -> FontMetrics
metrics     :: FontMetrics
    , View -> ScrolledWindow
scrollWin   :: ScrolledWindow
    , View -> IORef Point
shownTos    :: IORef Point
    , View -> IORef (Maybe (ConnectId DrawingArea))
winMotionSignal :: IORef (Maybe (ConnectId DrawingArea))
    }

data Iter = Iter
    { Iter -> BufferRef
iterFBufRef :: BufferRef
    , Iter -> Point
point       :: Point
    }

newBuffer :: BufferId -> R.YiString -> ControlM Buffer
newBuffer :: BufferId -> YiString -> ControlM Buffer
newBuffer id :: BufferId
id text :: YiString
text = do
    BufferRef
fBufRef <- YiM BufferRef -> ControlM BufferRef
forall a. YiM a -> ControlM a
liftYi (YiM BufferRef -> ControlM BufferRef)
-> (YiString -> YiM BufferRef) -> YiString -> ControlM BufferRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM BufferRef -> YiM BufferRef
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM BufferRef -> YiM BufferRef)
-> (YiString -> EditorM BufferRef) -> YiString -> YiM BufferRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferId -> YiString -> EditorM BufferRef
newBufferE BufferId
id (YiString -> ControlM BufferRef) -> YiString -> ControlM BufferRef
forall a b. (a -> b) -> a -> b
$ YiString
text
    Buffer -> ControlM Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer :: BufferRef -> Buffer
Buffer{..}

newView :: Buffer -> FontDescription -> ControlM View
newView :: Buffer -> FontDescription -> ControlM View
newView buffer :: Buffer
buffer font :: FontDescription
font = do
    Control
control  <- ControlM Control
forall r (m :: * -> *). MonadReader r m => m r
ask
    Config
config   <- YiM Config -> ControlM Config
forall a. YiM a -> ControlM a
liftYi YiM Config
forall (m :: * -> *). MonadEditor m => m Config
askCfg
    let viewFBufRef :: BufferRef
viewFBufRef = Buffer -> BufferRef
fBufRef Buffer
buffer
    Window
newWindow <-
      (Window -> Window) -> ControlM Window -> ControlM Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\w :: Window
w -> Window
w { height :: Int
height=50
                    , winRegion :: Region
winRegion = Point -> Point -> Region
mkRegion (Int -> Point
Point 0) (Int -> Point
Point 2000)
                    }) (ControlM Window -> ControlM Window)
-> ControlM Window -> ControlM Window
forall a b. (a -> b) -> a -> b
$ YiM Window -> ControlM Window
forall a. YiM a -> ControlM a
liftYi (YiM Window -> ControlM Window) -> YiM Window -> ControlM Window
forall a b. (a -> b) -> a -> b
$ EditorM Window -> YiM Window
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM Window -> YiM Window) -> EditorM Window -> YiM Window
forall a b. (a -> b) -> a -> b
$ Bool -> BufferRef -> EditorM Window
newWindowE Bool
False BufferRef
viewFBufRef
    let windowRef :: WindowRef
windowRef = Window -> WindowRef
wkey Window
newWindow
    YiM () -> ControlM ()
forall a. YiM a -> ControlM a
liftYi (YiM () -> ControlM ()) -> YiM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
        (PointedList Window -> Identity (PointedList Window))
-> Editor -> Identity Editor
Lens' Editor (PointedList Window)
windowsA ((PointedList Window -> Identity (PointedList Window))
 -> Editor -> Identity Editor)
-> (PointedList Window -> PointedList Window) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Window -> PointedList Window -> PointedList Window
forall a. a -> PointedList a -> PointedList a
PL.insertRight Window
newWindow
        Editor
e <- EditorM Editor
forall s (m :: * -> *). MonadState s m => m s
get
        Editor -> EditorM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Editor -> EditorM ()) -> Editor -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Editor -> Editor
focusAllSyntax Editor
e
    DrawingArea
drawArea <- IO DrawingArea -> ControlM DrawingArea
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO DrawingArea
drawingAreaNew
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ())
-> (UIConfig -> IO ()) -> UIConfig -> ControlM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrawingArea -> StateType -> Color -> IO ()
forall self.
WidgetClass self =>
self -> StateType -> Color -> IO ()
widgetModifyBg DrawingArea
drawArea StateType
StateNormal (Color -> IO ()) -> (UIConfig -> Color) -> UIConfig -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Color -> Color
mkCol Bool
False
      (Color -> Color) -> (UIConfig -> Color) -> UIConfig -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Color
Yi.Style.background (Attributes -> Color)
-> (UIConfig -> Attributes) -> UIConfig -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIStyle -> Attributes
baseAttributes (UIStyle -> Attributes)
-> (UIConfig -> UIStyle) -> UIConfig -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIConfig -> UIStyle
configStyle (UIConfig -> ControlM ()) -> UIConfig -> ControlM ()
forall a b. (a -> b) -> a -> b
$ Config -> UIConfig
configUI Config
config
    PangoContext
context  <- IO PangoContext -> ControlM PangoContext
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO PangoContext -> ControlM PangoContext)
-> IO PangoContext -> ControlM PangoContext
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO PangoContext
forall self. WidgetClass self => self -> IO PangoContext
widgetCreatePangoContext DrawingArea
drawArea
    PangoLayout
layout   <- IO PangoLayout -> ControlM PangoLayout
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO PangoLayout -> ControlM PangoLayout)
-> IO PangoLayout -> ControlM PangoLayout
forall a b. (a -> b) -> a -> b
$ PangoContext -> IO PangoLayout
layoutEmpty PangoContext
context
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ PangoLayout -> Maybe FontDescription -> IO ()
layoutSetFontDescription PangoLayout
layout (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
font)
    Language
language <- IO Language -> ControlM Language
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Language -> ControlM Language)
-> IO Language -> ControlM Language
forall a b. (a -> b) -> a -> b
$ PangoContext -> IO Language
contextGetLanguage PangoContext
context
    FontMetrics
metrics  <- IO FontMetrics -> ControlM FontMetrics
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO FontMetrics -> ControlM FontMetrics)
-> IO FontMetrics -> ControlM FontMetrics
forall a b. (a -> b) -> a -> b
$ PangoContext -> FontDescription -> Language -> IO FontMetrics
contextGetMetrics PangoContext
context FontDescription
font Language
language
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ PangoLayout -> GErrorMessage -> IO ()
forall string. GlibString string => PangoLayout -> string -> IO ()
layoutSetText PangoLayout
layout ("" :: Text)

    ScrolledWindow
scrollWin <- IO ScrolledWindow -> ControlM ScrolledWindow
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO ScrolledWindow -> ControlM ScrolledWindow)
-> IO ScrolledWindow -> ControlM ScrolledWindow
forall a b. (a -> b) -> a -> b
$ Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
scrolledWindowNew Maybe Adjustment
forall a. Maybe a
Nothing Maybe Adjustment
forall a. Maybe a
Nothing
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ do
        ScrolledWindow -> DrawingArea -> IO ()
forall self child.
(ScrolledWindowClass self, WidgetClass child) =>
self -> child -> IO ()
scrolledWindowAddWithViewport ScrolledWindow
scrollWin DrawingArea
drawArea
        ScrolledWindow -> PolicyType -> PolicyType -> IO ()
forall self.
ScrolledWindowClass self =>
self -> PolicyType -> PolicyType -> IO ()
scrolledWindowSetPolicy ScrolledWindow
scrollWin PolicyType
PolicyAutomatic PolicyType
PolicyNever

    Point
initialTos <-
      YiM Point -> ControlM Point
forall a. YiM a -> ControlM a
liftYi (YiM Point -> ControlM Point)
-> (BufferM Point -> YiM Point) -> BufferM Point -> ControlM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM Point -> YiM Point
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM Point -> YiM Point)
-> (BufferM Point -> EditorM Point) -> BufferM Point -> YiM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> BufferRef -> BufferM Point -> EditorM Point
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
newWindow BufferRef
viewFBufRef (BufferM Point -> ControlM Point)
-> BufferM Point -> ControlM Point
forall a b. (a -> b) -> a -> b
$
        (Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> (Mark -> Getting Point FBuffer Point) -> Mark -> BufferM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Getting Point FBuffer Point
Mark -> Lens' FBuffer Point
markPointA) (Mark -> BufferM Point) -> BufferM Mark -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MarkSet Mark -> Mark
forall a. MarkSet a -> a
fromMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks
    IORef Point
shownTos <- IO (IORef Point) -> ControlM (IORef Point)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (IORef Point) -> ControlM (IORef Point))
-> IO (IORef Point) -> ControlM (IORef Point)
forall a b. (a -> b) -> a -> b
$ Point -> IO (IORef Point)
forall a. a -> IO (IORef a)
newIORef Point
initialTos
    IORef (Maybe (ConnectId DrawingArea))
winMotionSignal <- IO (IORef (Maybe (ConnectId DrawingArea)))
-> ControlM (IORef (Maybe (ConnectId DrawingArea)))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (IORef (Maybe (ConnectId DrawingArea)))
 -> ControlM (IORef (Maybe (ConnectId DrawingArea))))
-> IO (IORef (Maybe (ConnectId DrawingArea)))
-> ControlM (IORef (Maybe (ConnectId DrawingArea)))
forall a b. (a -> b) -> a -> b
$ Maybe (ConnectId DrawingArea)
-> IO (IORef (Maybe (ConnectId DrawingArea)))
forall a. a -> IO (IORef a)
newIORef Maybe (ConnectId DrawingArea)
forall a. Maybe a
Nothing

    let view :: View
view = View :: BufferRef
-> WindowRef
-> DrawingArea
-> PangoLayout
-> Language
-> FontMetrics
-> ScrolledWindow
-> IORef Point
-> IORef (Maybe (ConnectId DrawingArea))
-> View
View {..}

    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> [EventMask] -> IO ()
forall self. WidgetClass self => self -> [EventMask] -> IO ()
Gtk.widgetAddEvents DrawingArea
drawArea [EventMask
KeyPressMask]
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> [AttrOp DrawingArea] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
Gtk.set DrawingArea
drawArea [Attr DrawingArea Bool
forall self. WidgetClass self => Attr self Bool
Gtk.widgetCanFocus Attr DrawingArea Bool -> Bool -> AttrOp DrawingArea
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Bool
True]

    IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea))
-> IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall a b. (a -> b) -> a -> b
$ DrawingArea
drawArea DrawingArea -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> (Event -> IO Bool) -> IO (ConnectId w)
`Gtk.onKeyPress` \event :: Event
event -> do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Yi Control Key Press = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Event -> String
forall a. Show a => a -> String
show Event
event
        ControlM () -> Control -> IO ()
forall a. ControlM a -> Control -> IO a
runControl (Action -> ControlM ()
runAction (Action -> ControlM ()) -> Action -> ControlM ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction (EditorM () -> Action) -> EditorM () -> Action
forall a b. (a -> b) -> a -> b
$ do
            WindowRef -> EditorM ()
focusWindowE WindowRef
windowRef
            BufferRef -> EditorM ()
switchToBufferE BufferRef
viewFBufRef) Control
control
        Bool
result <- ([Event] -> IO ()) -> Event -> IO Bool
processEvent (Yi -> [Event] -> IO ()
yiInput (Yi -> [Event] -> IO ()) -> Yi -> [Event] -> IO ()
forall a b. (a -> b) -> a -> b
$ Control -> Yi
controlYi Control
control) Event
event
        DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw DrawingArea
drawArea
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result

    IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea))
-> IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall a b. (a -> b) -> a -> b
$ DrawingArea
drawArea DrawingArea -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> (Event -> IO Bool) -> IO (ConnectId w)
`Gtk.onButtonPress` \event :: Event
event -> do
        DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetGrabFocus DrawingArea
drawArea
        ControlM Bool -> Control -> IO Bool
forall a. ControlM a -> Control -> IO a
runControl (View -> Event -> ControlM Bool
handleClick View
view Event
event) Control
control

    IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea))
-> IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall a b. (a -> b) -> a -> b
$ DrawingArea
drawArea DrawingArea -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> (Event -> IO Bool) -> IO (ConnectId w)
`Gtk.onButtonRelease` \event :: Event
event ->
        ControlM Bool -> Control -> IO Bool
forall a. ControlM a -> Control -> IO a
runControl (View -> Event -> ControlM Bool
handleClick View
view Event
event) Control
control

    IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea))
-> IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall a b. (a -> b) -> a -> b
$ DrawingArea
drawArea DrawingArea -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> (Event -> IO Bool) -> IO (ConnectId w)
`Gtk.onScroll` \event :: Event
event ->
        ControlM Bool -> Control -> IO Bool
forall a. ControlM a -> Control -> IO a
runControl (View -> Event -> ControlM Bool
handleScroll View
view Event
event) Control
control

    IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea))
-> IO (ConnectId DrawingArea) -> ControlM (ConnectId DrawingArea)
forall a b. (a -> b) -> a -> b
$ DrawingArea
drawArea DrawingArea -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> (Event -> IO Bool) -> IO (ConnectId w)
`Gtk.onExpose` \event :: Event
event -> do
        (text :: GErrorMessage
text, allAttrs :: [PangoAttribute]
allAttrs, debug :: ([(Point, Attributes)], [(Point, Attributes, Point)],
 GErrorMessage, Window, Point, Point, Int)
debug, tos :: Point
tos, rel :: Point -> Int
rel, point :: Point
point, inserting :: Bool
inserting) <-
          ControlM
  (GErrorMessage, [PangoAttribute],
   ([(Point, Attributes)], [(Point, Attributes, Point)],
    GErrorMessage, Window, Point, Point, Int),
   Point, Point -> Int, Point, Bool)
-> Control
-> IO
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall a. ControlM a -> Control -> IO a
runControl (YiM
  (GErrorMessage, [PangoAttribute],
   ([(Point, Attributes)], [(Point, Attributes, Point)],
    GErrorMessage, Window, Point, Point, Int),
   Point, Point -> Int, Point, Bool)
-> ControlM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall a. YiM a -> ControlM a
liftYi (YiM
   (GErrorMessage, [PangoAttribute],
    ([(Point, Attributes)], [(Point, Attributes, Point)],
     GErrorMessage, Window, Point, Point, Int),
    Point, Point -> Int, Point, Bool)
 -> ControlM
      (GErrorMessage, [PangoAttribute],
       ([(Point, Attributes)], [(Point, Attributes, Point)],
        GErrorMessage, Window, Point, Point, Int),
       Point, Point -> Int, Point, Bool))
-> YiM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
-> ControlM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall a b. (a -> b) -> a -> b
$ EditorM
  (GErrorMessage, [PangoAttribute],
   ([(Point, Attributes)], [(Point, Attributes, Point)],
    GErrorMessage, Window, Point, Point, Int),
   Point, Point -> Int, Point, Bool)
-> YiM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM
   (GErrorMessage, [PangoAttribute],
    ([(Point, Attributes)], [(Point, Attributes, Point)],
     GErrorMessage, Window, Point, Point, Int),
    Point, Point -> Int, Point, Bool)
 -> YiM
      (GErrorMessage, [PangoAttribute],
       ([(Point, Attributes)], [(Point, Attributes, Point)],
        GErrorMessage, Window, Point, Point, Int),
       Point, Point -> Int, Point, Bool))
-> EditorM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
-> YiM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall a b. (a -> b) -> a -> b
$ do
            Window
window <- WindowRef -> Editor -> Window
findWindowWith WindowRef
windowRef (Editor -> Window) -> EditorM Editor -> EditorM Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM Editor
forall s (m :: * -> *). MonadState s m => m s
get
            ASetter
  Editor Editor (Map BufferRef FBuffer) (Map BufferRef FBuffer)
-> (Map BufferRef FBuffer -> Map BufferRef FBuffer) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
(%=) ASetter
  Editor Editor (Map BufferRef FBuffer) (Map BufferRef FBuffer)
Lens' Editor (Map BufferRef FBuffer)
buffersA ((FBuffer -> FBuffer)
-> Map BufferRef FBuffer -> Map BufferRef FBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FBuffer -> FBuffer
clearSyntax (FBuffer -> FBuffer) -> (FBuffer -> FBuffer) -> FBuffer -> FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBuffer -> FBuffer
clearHighlight))
            let winh :: Int
winh = Window -> Int
height Window
window
            let tos :: Point
tos = Point -> Point -> Point
forall a. Ord a => a -> a -> a
max 0 (Region -> Point
regionStart (Window -> Region
winRegion Window
window))
            let bos :: Point
bos = Region -> Point
regionEnd (Window -> Region
winRegion Window
window)
            let rel :: Point -> b
rel p :: Point
p = Point -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Point
p Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
tos)

            Window
-> BufferRef
-> BufferM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
-> EditorM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
window BufferRef
viewFBufRef (BufferM
   (GErrorMessage, [PangoAttribute],
    ([(Point, Attributes)], [(Point, Attributes, Point)],
     GErrorMessage, Window, Point, Point, Int),
    Point, Point -> Int, Point, Bool)
 -> EditorM
      (GErrorMessage, [PangoAttribute],
       ([(Point, Attributes)], [(Point, Attributes, Point)],
        GErrorMessage, Window, Point, Point, Int),
       Point, Point -> Int, Point, Bool))
-> BufferM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
-> EditorM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall a b. (a -> b) -> a -> b
$ do
                -- tos       <- getMarkPointB =<< fromMark <$> askMarks
                YiString
rope      <- Direction -> Point -> BufferM YiString
streamB Direction
Forward Point
tos
                Point
point     <- BufferM Point
pointB
                Bool
inserting <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
insertingA

                GErrorMessage
modeNm <- (FBuffer -> GErrorMessage) -> BufferM GErrorMessage
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((forall syntax. Mode syntax -> GErrorMessage)
-> FBuffer -> GErrorMessage
forall a. (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 forall syntax. Mode syntax -> GErrorMessage
modeName)

    --            let (tos, point, text, picture) = do runBu
    --                        from     <- getMarkPointB =<< fromMark <$> askMarks
    --                        rope     <- streamB Forward from
    --                        p        <- pointB
                let content :: YiString
content = (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString, YiString) -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> YiString -> (YiString, YiString)
splitAtLine Int
winh YiString
rope
                -- allow BOS offset to be just after the last line
                let addNL :: YiString -> YiString
addNL = if YiString -> Int
R.countNewLines YiString
content Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
winh
                              then YiString -> YiString
forall a. a -> a
id
                              else (YiString -> Char -> YiString
`R.snoc` '\n')
                    sty :: UIStyle
sty = UIConfig -> UIStyle
configStyle (UIConfig -> UIStyle) -> UIConfig -> UIStyle
forall a b. (a -> b) -> a -> b
$ Config -> UIConfig
configUI Config
config
                          -- attributesPictureAndSelB sty (currentRegex e)
                          --   (mkRegion tos bos)
                          -- return (from, p, addNL $ Rope.toString content,
                          --         picture)
                let text :: GErrorMessage
text = YiString -> GErrorMessage
R.toText (YiString -> GErrorMessage) -> YiString -> GErrorMessage
forall a b. (a -> b) -> a -> b
$ YiString -> YiString
addNL YiString
content

                [(Point, Attributes)]
picture <- UIStyle
-> Maybe SearchExp -> Region -> BufferM [(Point, Attributes)]
attributesPictureAndSelB UIStyle
sty Maybe SearchExp
forall a. Maybe a
Nothing
                           (Point -> Point -> Region
mkRegion Point
tos Point
bos)

                -- add color attributes.
                let picZip :: [((Point, Attributes), Point)]
picZip = [(Point, Attributes)] -> [Point] -> [((Point, Attributes), Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Point, Attributes)]
picture ([Point] -> [((Point, Attributes), Point)])
-> [Point] -> [((Point, Attributes), Point)]
forall a b. (a -> b) -> a -> b
$ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop 1 ((Point, Attributes) -> Point
forall a b. (a, b) -> a
fst ((Point, Attributes) -> Point) -> [(Point, Attributes)] -> [Point]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Point, Attributes)]
picture) [Point] -> [Point] -> [Point]
forall a. Semigroup a => a -> a -> a
<> [Point
bos]
                    strokes :: [(Point, Attributes, Point)]
strokes = [ (Point
start',Attributes
s,Point
end') | ((start' :: Point
start', s :: Attributes
s), end' :: Point
end') <- [((Point, Attributes), Point)]
picZip
                                                , Attributes
s Attributes -> Attributes -> Bool
forall a. Eq a => a -> a -> Bool
/= Attributes
emptyAttributes ]

                    rel :: Point -> b
rel p :: Point
p = Point -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Point
p Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
tos)
                    allAttrs :: [PangoAttribute]
allAttrs = [[PangoAttribute]] -> [PangoAttribute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PangoAttribute]] -> [PangoAttribute])
-> [[PangoAttribute]] -> [PangoAttribute]
forall a b. (a -> b) -> a -> b
$ do
                      (p1 :: Point
p1, Attributes fg :: Color
fg bg :: Color
bg _rv :: Bool
_rv bd :: Bool
bd itlc :: Bool
itlc udrl :: Bool
udrl, p2 :: Point
p2) <- [(Point, Attributes, Point)]
strokes
                      let atr :: (t -> t -> t) -> t
atr x :: t -> t -> t
x = t -> t -> t
x (Point -> t
forall b. Num b => Point -> b
rel Point
p1) (Point -> t
forall b. Num b => Point -> b
rel Point
p2)
                          if' :: Bool -> p -> p -> p
if' p :: Bool
p x :: p
x y :: p
y = if Bool
p then p
x else p
y
                      [PangoAttribute] -> [[PangoAttribute]]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Int -> Int -> Color -> PangoAttribute) -> Color -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr Int -> Int -> Color -> PangoAttribute
AttrForeground (Color -> PangoAttribute) -> Color -> PangoAttribute
forall a b. (a -> b) -> a -> b
$ Bool -> Color -> Color
mkCol Bool
True Color
fg
                             , (Int -> Int -> Color -> PangoAttribute) -> Color -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr Int -> Int -> Color -> PangoAttribute
AttrBackground (Color -> PangoAttribute) -> Color -> PangoAttribute
forall a b. (a -> b) -> a -> b
$ Bool -> Color -> Color
mkCol Bool
False Color
bg
                             , (Int -> Int -> FontStyle -> PangoAttribute)
-> FontStyle -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr Int -> Int -> FontStyle -> PangoAttribute
AttrStyle (FontStyle -> PangoAttribute) -> FontStyle -> PangoAttribute
forall a b. (a -> b) -> a -> b
$ Bool -> FontStyle -> FontStyle -> FontStyle
forall p. Bool -> p -> p -> p
if' Bool
itlc FontStyle
StyleItalic FontStyle
StyleNormal
                             , (Int -> Int -> Underline -> PangoAttribute)
-> Underline -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr Int -> Int -> Underline -> PangoAttribute
AttrUnderline (Underline -> PangoAttribute) -> Underline -> PangoAttribute
forall a b. (a -> b) -> a -> b
$
                                 Bool -> Underline -> Underline -> Underline
forall p. Bool -> p -> p -> p
if' Bool
udrl Underline
UnderlineSingle Underline
UnderlineNone
                             , (Int -> Int -> Weight -> PangoAttribute)
-> Weight -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr Int -> Int -> Weight -> PangoAttribute
AttrWeight (Weight -> PangoAttribute) -> Weight -> PangoAttribute
forall a b. (a -> b) -> a -> b
$ Bool -> Weight -> Weight -> Weight
forall p. Bool -> p -> p -> p
if' Bool
bd Weight
WeightBold Weight
WeightNormal
                             ]


                (GErrorMessage, [PangoAttribute],
 ([(Point, Attributes)], [(Point, Attributes, Point)],
  GErrorMessage, Window, Point, Point, Int),
 Point, Point -> Int, Point, Bool)
-> BufferM
     (GErrorMessage, [PangoAttribute],
      ([(Point, Attributes)], [(Point, Attributes, Point)],
       GErrorMessage, Window, Point, Point, Int),
      Point, Point -> Int, Point, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (GErrorMessage
text, [PangoAttribute]
allAttrs, ([(Point, Attributes)]
picture, [(Point, Attributes, Point)]
strokes, GErrorMessage
modeNm,
                                         Window
window, Point
tos, Point
bos, Int
winh),
                        Point
tos, Point -> Int
forall b. Num b => Point -> b
rel, Point
point, Bool
inserting)) Control
control

        -- putStrLn $ "Setting Layout Attributes " <> show debug
        PangoLayout -> [PangoAttribute] -> IO ()
layoutSetAttributes PangoLayout
layout [PangoAttribute]
allAttrs
        -- putStrLn "Done Stting Layout Attributes"
        DrawWindow
dw      <- DrawingArea -> IO DrawWindow
forall widget. WidgetClass widget => widget -> IO DrawWindow
widgetGetDrawWindow DrawingArea
drawArea
        GC
gc      <- DrawWindow -> IO GC
forall d. DrawableClass d => d -> IO GC
gcNew DrawWindow
dw
        GErrorMessage
oldText <- PangoLayout -> IO GErrorMessage
forall string. GlibString string => PangoLayout -> IO string
layoutGetText PangoLayout
layout
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GErrorMessage
text GErrorMessage -> GErrorMessage -> Bool
forall a. Eq a => a -> a -> Bool
/= GErrorMessage
oldText) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PangoLayout -> GErrorMessage -> IO ()
forall string. GlibString string => PangoLayout -> string -> IO ()
layoutSetText PangoLayout
layout GErrorMessage
text
        DrawWindow -> GC -> Int -> Int -> PangoLayout -> IO ()
forall d.
DrawableClass d =>
d -> GC -> Int -> Int -> PangoLayout -> IO ()
drawLayout DrawWindow
dw GC
gc 0 0 PangoLayout
layout
        IO () -> IO ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Point -> Point -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Point
shownTos Point
tos

        -- paint the cursor
        (PangoRectangle curx :: Double
curx cury :: Double
cury curw :: Double
curw curh :: Double
curh, _) <-
          PangoLayout -> Int -> IO (PangoRectangle, PangoRectangle)
layoutGetCursorPos PangoLayout
layout (Point -> Int
rel Point
point)
        PangoRectangle chx :: Double
chx chy :: Double
chy chw :: Double
chw chh :: Double
chh          <-
          PangoLayout -> Int -> IO PangoRectangle
layoutIndexToPos PangoLayout
layout (Point -> Int
rel Point
point)

        GC -> GCValues -> IO ()
gcSetValues GC
gc
          (GCValues
newGCValues { foreground :: Color
Gtk.foreground = Bool -> Color -> Color
mkCol Bool
True (Color -> Color) -> (UIConfig -> Color) -> UIConfig -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Color
Yi.Style.foreground
                                          (Attributes -> Color)
-> (UIConfig -> Attributes) -> UIConfig -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIStyle -> Attributes
baseAttributes (UIStyle -> Attributes)
-> (UIConfig -> UIStyle) -> UIConfig -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UIConfig -> UIStyle
configStyle (UIConfig -> Color) -> UIConfig -> Color
forall a b. (a -> b) -> a -> b
$
                                          Config -> UIConfig
configUI Config
config })
        if Bool
inserting
          then DrawWindow -> GC -> (Int, Int) -> (Int, Int) -> IO ()
forall d.
DrawableClass d =>
d -> GC -> (Int, Int) -> (Int, Int) -> IO ()
drawLine DrawWindow
dw GC
gc (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
curx, Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
cury) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
curx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
curw, Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
cury Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
curh)
          else DrawWindow -> GC -> Bool -> Int -> Int -> Int -> Int -> IO ()
forall d.
DrawableClass d =>
d -> GC -> Bool -> Int -> Int -> Int -> Int -> IO ()
drawRectangle DrawWindow
dw GC
gc Bool
False (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
chx) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
chy) (if Double
chw Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
chw else 8) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
chh)

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetGrabFocus DrawingArea
drawArea

    IORef [TabInfo]
tabsRef <- (Control -> IORef [TabInfo]) -> ControlM (IORef [TabInfo])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> IORef [TabInfo]
tabCache
    [TabInfo]
ts <- IO [TabInfo] -> ControlM [TabInfo]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [TabInfo] -> ControlM [TabInfo])
-> IO [TabInfo] -> ControlM [TabInfo]
forall a b. (a -> b) -> a -> b
$ IORef [TabInfo] -> IO [TabInfo]
forall a. IORef a -> IO a
readIORef IORef [TabInfo]
tabsRef
    -- TODO: the Tab idkey should be assigned using
    -- Yi.Editor.newRef. But we can't modify that here, since our
    -- access to 'Yi' is readonly.
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ IORef [TabInfo] -> [TabInfo] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [TabInfo]
tabsRef (Tab -> TabInfo
TabInfo (Int -> Window -> Tab
makeTab1 0 Window
newWindow)TabInfo -> [TabInfo] -> [TabInfo]
forall a. a -> [a] -> [a]
:[TabInfo]
ts)

    IORef (Map WindowRef View)
viewsRef <- (Control -> IORef (Map WindowRef View))
-> ControlM (IORef (Map WindowRef View))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Control -> IORef (Map WindowRef View)
views
    Map WindowRef View
vs <- IO (Map WindowRef View) -> ControlM (Map WindowRef View)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Map WindowRef View) -> ControlM (Map WindowRef View))
-> IO (Map WindowRef View) -> ControlM (Map WindowRef View)
forall a b. (a -> b) -> a -> b
$ IORef (Map WindowRef View) -> IO (Map WindowRef View)
forall a. IORef a -> IO a
readIORef IORef (Map WindowRef View)
viewsRef
    IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ IORef (Map WindowRef View) -> Map WindowRef View -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map WindowRef View)
viewsRef (Map WindowRef View -> IO ()) -> Map WindowRef View -> IO ()
forall a b. (a -> b) -> a -> b
$ WindowRef -> View -> Map WindowRef View -> Map WindowRef View
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert WindowRef
windowRef View
view Map WindowRef View
vs

    View -> ControlM View
forall (m :: * -> *) a. Monad m => a -> m a
return View
view
  where
    clearHighlight :: FBuffer -> FBuffer
clearHighlight fb :: FBuffer
fb =
      -- if there were updates, then hide the selection.
      let h :: Bool
h = Getting Bool FBuffer Bool -> FBuffer -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA FBuffer
fb
          us :: Seq UIUpdate
us = Getting (Seq UIUpdate) FBuffer (Seq UIUpdate)
-> FBuffer -> Seq UIUpdate
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq UIUpdate) FBuffer (Seq UIUpdate)
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA FBuffer
fb
      in (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Bool
h Bool -> Bool -> Bool
&& Seq UIUpdate -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq UIUpdate
us) (FBuffer -> FBuffer) -> FBuffer -> FBuffer
forall a b. (a -> b) -> a -> b
$ FBuffer
fb

{-# ANN setBufferMode ("HLint: ignore Redundant do" :: String) #-}
setBufferMode :: FilePath -> Buffer -> ControlM ()
setBufferMode :: String -> Buffer -> ControlM ()
setBufferMode f :: String
f buffer :: Buffer
buffer = do
    let bufRef :: BufferRef
bufRef = Buffer -> BufferRef
fBufRef Buffer
buffer
    -- adjust the mode
    [AnyMode]
tbl <- YiM [AnyMode] -> ControlM [AnyMode]
forall a. YiM a -> ControlM a
liftYi (YiM [AnyMode] -> ControlM [AnyMode])
-> YiM [AnyMode] -> ControlM [AnyMode]
forall a b. (a -> b) -> a -> b
$ (Yi -> [AnyMode]) -> YiM [AnyMode]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Config -> [AnyMode]
modeTable (Config -> [AnyMode]) -> (Yi -> Config) -> Yi -> [AnyMode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yi -> Config
yiConfig)
    YiString
contents <- YiM YiString -> ControlM YiString
forall a. YiM a -> ControlM a
liftYi (YiM YiString -> ControlM YiString)
-> YiM YiString -> ControlM YiString
forall a b. (a -> b) -> a -> b
$ BufferRef -> BufferM YiString -> YiM YiString
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
bufRef BufferM YiString
elemsB
    let header :: String
header = YiString -> String
R.toString (YiString -> String) -> YiString -> String
forall a b. (a -> b) -> a -> b
$ Int -> YiString -> YiString
R.take 1024 YiString
contents
        hmode :: GErrorMessage
hmode = case String
header String -> String -> AllTextSubmatches [] String
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ("\\-\\*\\- *([^ ]*) *\\-\\*\\-" :: String) of
            AllTextSubmatches [_,m :: String
m] -> String -> GErrorMessage
T.pack String
m
            _ -> ""
        Just mode :: AnyMode
mode = (AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode m :: Mode syntax
m)-> Mode syntax -> GErrorMessage
forall syntax. Mode syntax -> GErrorMessage
modeName Mode syntax
m GErrorMessage -> GErrorMessage -> Bool
forall a. Eq a => a -> a -> Bool
== GErrorMessage
hmode) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    (AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode m :: Mode syntax
m)-> Mode syntax -> String -> YiString -> Bool
forall syntax. Mode syntax -> String -> YiString -> Bool
modeApplies Mode syntax
m String
f YiString
contents) [AnyMode]
tbl Maybe AnyMode -> Maybe AnyMode -> Maybe AnyMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    AnyMode -> Maybe AnyMode
forall a. a -> Maybe a
Just (Mode Any -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode Any
forall syntax. Mode syntax
emptyMode)
    case AnyMode
mode of
        AnyMode newMode :: Mode syntax
newMode -> do
            -- liftBase $ putStrLn $ show (f, modeName newMode)
            YiM () -> ControlM ()
forall a. YiM a -> ControlM a
liftYi (YiM () -> ControlM ()) -> YiM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
                BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
bufRef (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
                    Mode syntax -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode syntax
newMode
                    (FBuffer -> FBuffer) -> BufferM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify FBuffer -> FBuffer
clearSyntax
                BufferRef -> EditorM ()
switchToBufferE BufferRef
bufRef
            -- withEditor focusAllSyntax

withBuffer :: Buffer -> BufferM a -> ControlM a
withBuffer :: Buffer -> BufferM a -> ControlM a
withBuffer Buffer{fBufRef :: Buffer -> BufferRef
fBufRef = BufferRef
b} f :: BufferM a
f = YiM a -> ControlM a
forall a. YiM a -> ControlM a
liftYi (YiM a -> ControlM a) -> YiM a -> ControlM a
forall a b. (a -> b) -> a -> b
$ BufferRef -> BufferM a -> YiM a
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b BufferM a
f

getBuffer :: View -> Buffer
getBuffer :: View -> Buffer
getBuffer view :: View
view = Buffer :: BufferRef -> Buffer
Buffer {fBufRef :: BufferRef
fBufRef = View -> BufferRef
viewFBufRef View
view}

setText :: Buffer -> YiString -> ControlM ()
setText :: Buffer -> YiString -> ControlM ()
setText b :: Buffer
b text :: YiString
text = Buffer -> BufferM () -> ControlM ()
forall a. Buffer -> BufferM a -> ControlM a
withBuffer Buffer
b (BufferM () -> ControlM ()) -> BufferM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ do
    Region
r <- TextUnit -> BufferM Region
regionOfB TextUnit
Document
    Region -> YiString -> BufferM ()
replaceRegionB Region
r YiString
text

getText :: Buffer -> Iter -> Iter -> ControlM Text
getText :: Buffer -> Iter -> Iter -> ControlM GErrorMessage
getText b :: Buffer
b Iter{point :: Iter -> Point
point = Point
p1} Iter{point :: Iter -> Point
point = Point
p2} =
  (YiString -> GErrorMessage)
-> ControlM YiString -> ControlM GErrorMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> GErrorMessage
toText (ControlM YiString -> ControlM GErrorMessage)
-> (Region -> ControlM YiString)
-> Region
-> ControlM GErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> BufferM YiString -> ControlM YiString
forall a. Buffer -> BufferM a -> ControlM a
withBuffer Buffer
b (BufferM YiString -> ControlM YiString)
-> (Region -> BufferM YiString) -> Region -> ControlM YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> BufferM YiString
readRegionB (Region -> ControlM GErrorMessage)
-> Region -> ControlM GErrorMessage
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p1 Point
p2

mkCol :: Bool -- ^ is foreground?
      -> Yi.Style.Color -> Gtk.Color
mkCol :: Bool -> Color -> Color
mkCol True  Default = Word16 -> Word16 -> Word16 -> Color
Color 0 0 0
mkCol False Default = Word16 -> Word16 -> Word16 -> Color
Color Word16
forall a. Bounded a => a
maxBound Word16
forall a. Bounded a => a
maxBound Word16
forall a. Bounded a => a
maxBound
mkCol _ (RGB x :: Word8
x y :: Word8
y z :: Word8
z) = Word16 -> Word16 -> Word16 -> Color
Color (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* 256)
                            (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* 256)
                            (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
z Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* 256)

handleClick :: View -> Gdk.Events.Event -> ControlM Bool
handleClick :: View -> Event -> ControlM Bool
handleClick view :: View
view event :: Event
event = do
  Control
control  <- ControlM Control
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- (_tabIdx,winIdx,w) <- getWinInfo ref <$> readIORef (tabCache ui)

  GErrorMessage -> ControlM ()
forall (m :: * -> *). MonadBase IO m => GErrorMessage -> m ()
logPutStrLn (GErrorMessage -> ControlM ()) -> GErrorMessage -> ControlM ()
forall a b. (a -> b) -> a -> b
$ "Click: " GErrorMessage -> GErrorMessage -> GErrorMessage
forall a. Semigroup a => a -> a -> a
<> (Double, Double, Click) -> GErrorMessage
forall a. Show a => a -> GErrorMessage
showT (Event -> Double
Gdk.Events.eventX Event
event,
                                    Event -> Double
Gdk.Events.eventY Event
event,
                                    Event -> Click
Gdk.Events.eventClick Event
event)

  -- retrieve the clicked offset.
  (_,layoutIndex :: Int
layoutIndex,_) <- IO (Bool, Int, Int) -> ControlM (Bool, Int, Int)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO (Bool, Int, Int) -> ControlM (Bool, Int, Int))
-> IO (Bool, Int, Int) -> ControlM (Bool, Int, Int)
forall a b. (a -> b) -> a -> b
$ PangoLayout -> Double -> Double -> IO (Bool, Int, Int)
layoutXYToIndex (View -> PangoLayout
layout View
view)
                       (Event -> Double
Gdk.Events.eventX Event
event) (Event -> Double
Gdk.Events.eventY Event
event)
  Point
tos <- IO Point -> ControlM Point
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Point -> ControlM Point) -> IO Point -> ControlM Point
forall a b. (a -> b) -> a -> b
$ IORef Point -> IO Point
forall a. IORef a -> IO a
readIORef (View -> IORef Point
shownTos View
view)
  let p1 :: Point
p1 = Point
tos Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int -> Point
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
layoutIndex

  let winRef :: WindowRef
winRef = View -> WindowRef
windowRef View
view

  -- maybe focus the window
  -- logPutStrLn $ "Clicked inside window: " <> show view

--  let focusWindow = do
      -- TODO: check that tabIdx is the focus?
--      (%=) windowsA (fromJust . PL.move winIdx)

  IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ case (Event -> Click
Gdk.Events.eventClick Event
event, Event -> MouseButton
Gdk.Events.eventButton Event
event) of
     (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> do
        ConnectId DrawingArea
cid <- DrawingArea
-> Bool -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> Bool -> (Event -> IO Bool) -> IO (ConnectId w)
onMotionNotify (View -> DrawingArea
drawArea View
view) Bool
False ((Event -> IO Bool) -> IO (ConnectId DrawingArea))
-> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall a b. (a -> b) -> a -> b
$ \event :: Event
event ->
            ControlM Bool -> Control -> IO Bool
forall a. ControlM a -> Control -> IO a
runControl (View -> Point -> Event -> ControlM Bool
handleMove View
view Point
p1 Event
event) Control
control
        IORef (Maybe (ConnectId DrawingArea))
-> Maybe (ConnectId DrawingArea) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (View -> IORef (Maybe (ConnectId DrawingArea))
winMotionSignal View
view) (Maybe (ConnectId DrawingArea) -> IO ())
-> Maybe (ConnectId DrawingArea) -> IO ()
forall a b. (a -> b) -> a -> b
$ ConnectId DrawingArea -> Maybe (ConnectId DrawingArea)
forall a. a -> Maybe a
Just ConnectId DrawingArea
cid

     _ -> do
       IO ()
-> (ConnectId DrawingArea -> IO ())
-> Maybe (ConnectId DrawingArea)
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ConnectId DrawingArea -> IO ()
forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalDisconnect (Maybe (ConnectId DrawingArea) -> IO ())
-> IO (Maybe (ConnectId DrawingArea)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Maybe (ConnectId DrawingArea))
-> IO (Maybe (ConnectId DrawingArea))
forall a. IORef a -> IO a
readIORef (View -> IORef (Maybe (ConnectId DrawingArea))
winMotionSignal View
view)
       IORef (Maybe (ConnectId DrawingArea))
-> Maybe (ConnectId DrawingArea) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (View -> IORef (Maybe (ConnectId DrawingArea))
winMotionSignal View
view) Maybe (ConnectId DrawingArea)
forall a. Maybe a
Nothing

  case (Event -> Click
Gdk.Events.eventClick Event
event, Event -> MouseButton
Gdk.Events.eventButton Event
event) of
    (Gdk.Events.SingleClick, Gdk.Events.LeftButton) ->
      Action -> ControlM ()
runAction (Action -> ControlM ())
-> (EditorM () -> Action) -> EditorM () -> ControlM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> ControlM ()) -> EditorM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ do
        -- b <- gets $ (bkey . findBufferWith (viewFBufRef view))
        -- focusWindow
        Window
window <- WindowRef -> Editor -> Window
findWindowWith WindowRef
winRef (Editor -> Window) -> EditorM Editor -> EditorM Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM Editor
forall s (m :: * -> *). MonadState s m => m s
get
        Window -> BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
window (View -> BufferRef
viewFBufRef View
view) (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
            Point -> BufferM ()
moveTo Point
p1
            Bool -> BufferM ()
setVisibleSelection Bool
False
    -- (Gdk.Events.SingleClick, _) -> runAction focusWindow
    (Gdk.Events.ReleaseClick, Gdk.Events.MiddleButton) -> do
        Display
disp <- IO Display -> ControlM Display
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Display -> ControlM Display) -> IO Display -> ControlM Display
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO Display
forall self. WidgetClass self => self -> IO Display
widgetGetDisplay (View -> DrawingArea
drawArea View
view)
        Clipboard
cb <- IO Clipboard -> ControlM Clipboard
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Clipboard -> ControlM Clipboard)
-> IO Clipboard -> ControlM Clipboard
forall a b. (a -> b) -> a -> b
$ Display -> SelectionTag -> IO Clipboard
clipboardGetForDisplay Display
disp SelectionTag
selectionPrimary
        let cbHandler :: Maybe R.YiString -> IO ()
            cbHandler :: Maybe YiString -> IO ()
cbHandler Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            cbHandler (Just txt :: YiString
txt) = ControlM () -> Control -> IO ()
forall a. ControlM a -> Control -> IO a
runControl (Action -> ControlM ()
runAction (Action -> ControlM ())
-> (EditorM () -> Action) -> EditorM () -> ControlM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> ControlM ()) -> EditorM () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ do
                Window
window <- WindowRef -> Editor -> Window
findWindowWith WindowRef
winRef (Editor -> Window) -> EditorM Editor -> EditorM Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM Editor
forall s (m :: * -> *). MonadState s m => m s
get
                Window -> BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
window (View -> BufferRef
viewFBufRef View
view) (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
                    BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB
                    Point -> BufferM ()
moveTo Point
p1
                    YiString -> BufferM ()
insertN YiString
txt) Control
control
        IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ Clipboard -> (Maybe GErrorMessage -> IO ()) -> IO ()
forall self string.
(ClipboardClass self, GlibString string) =>
self -> (Maybe string -> IO ()) -> IO ()
clipboardRequestText Clipboard
cb (Maybe YiString -> IO ()
cbHandler (Maybe YiString -> IO ())
-> (Maybe GErrorMessage -> Maybe YiString)
-> Maybe GErrorMessage
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GErrorMessage -> YiString)
-> Maybe GErrorMessage -> Maybe YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GErrorMessage -> YiString
R.fromText)
    _ -> () -> ControlM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw (View -> DrawingArea
drawArea View
view)
  Bool -> ControlM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

handleScroll :: View -> Gdk.Events.Event -> ControlM Bool
handleScroll :: View -> Event -> ControlM Bool
handleScroll view :: View
view event :: Event
event = do
  let editorAction :: EditorM ()
editorAction =
        BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM ()
vimScrollB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ case Event -> ScrollDirection
Gdk.Events.eventDirection Event
event of
                        Gdk.Events.ScrollUp   -> -1
                        Gdk.Events.ScrollDown -> 1
                        _ -> 0 -- Left/right scrolling not supported

  Action -> ControlM ()
runAction (Action -> ControlM ()) -> Action -> ControlM ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA EditorM ()
editorAction
  IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw (View -> DrawingArea
drawArea View
view)
  Bool -> ControlM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

handleMove :: View -> Point -> Gdk.Events.Event -> ControlM Bool
handleMove :: View -> Point -> Event -> ControlM Bool
handleMove view :: View
view p0 :: Point
p0 event :: Event
event = do
  GErrorMessage -> ControlM ()
forall (m :: * -> *). MonadBase IO m => GErrorMessage -> m ()
logPutStrLn (GErrorMessage -> ControlM ()) -> GErrorMessage -> ControlM ()
forall a b. (a -> b) -> a -> b
$ "Motion: " GErrorMessage -> GErrorMessage -> GErrorMessage
forall a. Semigroup a => a -> a -> a
<> (Double, Double) -> GErrorMessage
forall a. Show a => a -> GErrorMessage
showT (Event -> Double
Gdk.Events.eventX Event
event,
                                     Event -> Double
Gdk.Events.eventY Event
event)

  -- retrieve the clicked offset.
  (_,layoutIndex :: Int
layoutIndex,_) <-
    IO (Bool, Int, Int) -> ControlM (Bool, Int, Int)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Bool, Int, Int) -> ControlM (Bool, Int, Int))
-> IO (Bool, Int, Int) -> ControlM (Bool, Int, Int)
forall a b. (a -> b) -> a -> b
$ PangoLayout -> Double -> Double -> IO (Bool, Int, Int)
layoutXYToIndex (View -> PangoLayout
layout View
view)
    (Event -> Double
Gdk.Events.eventX Event
event) (Event -> Double
Gdk.Events.eventY Event
event)
  Point
tos <- IO Point -> ControlM Point
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Point -> ControlM Point) -> IO Point -> ControlM Point
forall a b. (a -> b) -> a -> b
$ IORef Point -> IO Point
forall a. IORef a -> IO a
readIORef (View -> IORef Point
shownTos View
view)
  let p1 :: Point
p1 = Point
tos Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int -> Point
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
layoutIndex


  let editorAction :: EditorM ()
editorAction = do
        Maybe YiString
txt <- BufferM (Maybe YiString) -> EditorM (Maybe YiString)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe YiString) -> EditorM (Maybe YiString))
-> BufferM (Maybe YiString) -> EditorM (Maybe YiString)
forall a b. (a -> b) -> a -> b
$
           if Point
p0 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
p1
            then YiString -> Maybe YiString
forall a. a -> Maybe a
Just (YiString -> Maybe YiString)
-> BufferM YiString -> BufferM (Maybe YiString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
              Mark
m <- MarkSet Mark -> Mark
forall a. MarkSet a -> a
selMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks
              Mark -> Lens' FBuffer Point
markPointA Mark
m ((Point -> Identity Point) -> FBuffer -> Identity FBuffer)
-> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
p0
              Point -> BufferM ()
moveTo Point
p1
              Bool -> BufferM ()
setVisibleSelection Bool
True
              Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB
            else Maybe YiString -> BufferM (Maybe YiString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe YiString
forall a. Maybe a
Nothing
        EditorM ()
-> (YiString -> EditorM ()) -> Maybe YiString -> EditorM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) YiString -> EditorM ()
setRegE Maybe YiString
txt

  Action -> ControlM ()
runAction (Action -> ControlM ()) -> Action -> ControlM ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction EditorM ()
editorAction
  -- drawWindowGetPointer (textview w) -- be ready for next message.

  -- Relies on uiActionCh being synchronous
  IORef YiString
selection <- IO (IORef YiString) -> ControlM (IORef YiString)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (IORef YiString) -> ControlM (IORef YiString))
-> IO (IORef YiString) -> ControlM (IORef YiString)
forall a b. (a -> b) -> a -> b
$ YiString -> IO (IORef YiString)
forall a. a -> IO (IORef a)
newIORef ""
  let yiAction :: YiM ()
yiAction = do
        YiString
txt <- BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB)
             :: YiM R.YiString
        IO () -> YiM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ IORef YiString -> YiString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef YiString
selection YiString
txt
  Action -> ControlM ()
runAction (Action -> ControlM ()) -> Action -> ControlM ()
forall a b. (a -> b) -> a -> b
$ YiM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction YiM ()
yiAction
  YiString
txt <- IO YiString -> ControlM YiString
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO YiString -> ControlM YiString)
-> IO YiString -> ControlM YiString
forall a b. (a -> b) -> a -> b
$ IORef YiString -> IO YiString
forall a. IORef a -> IO a
readIORef IORef YiString
selection

  Display
disp <- IO Display -> ControlM Display
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Display -> ControlM Display) -> IO Display -> ControlM Display
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO Display
forall self. WidgetClass self => self -> IO Display
widgetGetDisplay (View -> DrawingArea
drawArea View
view)
  Clipboard
cb <- IO Clipboard -> ControlM Clipboard
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Clipboard -> ControlM Clipboard)
-> IO Clipboard -> ControlM Clipboard
forall a b. (a -> b) -> a -> b
$ Display -> SelectionTag -> IO Clipboard
clipboardGetForDisplay Display
disp SelectionTag
selectionPrimary
  IO Bool -> ControlM Bool
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Bool -> ControlM Bool) -> IO Bool -> ControlM Bool
forall a b. (a -> b) -> a -> b
$ Clipboard
-> [(SelectionTag, GErrorDomain)]
-> (GErrorDomain -> SelectionDataM ())
-> IO ()
-> IO Bool
forall self.
ClipboardClass self =>
self
-> [(SelectionTag, GErrorDomain)]
-> (GErrorDomain -> SelectionDataM ())
-> IO ()
-> IO Bool
clipboardSetWithData Clipboard
cb [(SelectionTag
targetString,0)]
      (\0 -> ReaderT (Ptr ()) IO Bool -> SelectionDataM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (GErrorMessage -> ReaderT (Ptr ()) IO Bool
forall string.
GlibString string =>
string -> ReaderT (Ptr ()) IO Bool
selectionDataSetText (GErrorMessage -> ReaderT (Ptr ()) IO Bool)
-> GErrorMessage -> ReaderT (Ptr ()) IO Bool
forall a b. (a -> b) -> a -> b
$ YiString -> GErrorMessage
R.toText YiString
txt)) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

  IO () -> ControlM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> ControlM ()) -> IO () -> ControlM ()
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw (View -> DrawingArea
drawArea View
view)
  Bool -> ControlM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

processEvent :: ([Event] -> IO ()) -> Gdk.Events.Event -> IO Bool
processEvent :: ([Event] -> IO ()) -> Event -> IO Bool
processEvent ch :: [Event] -> IO ()
ch ev :: Event
ev = do
  -- logPutStrLn $ "Gtk.Event: " <> show ev
  -- logPutStrLn $ "Event: " <> show (gtkToYiEvent ev)
  case Event -> Maybe Event
gtkToYiEvent Event
ev of
    Nothing -> GErrorMessage -> IO ()
forall (m :: * -> *). MonadBase IO m => GErrorMessage -> m ()
logPutStrLn (GErrorMessage -> IO ()) -> GErrorMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ "Event not translatable: " GErrorMessage -> GErrorMessage -> GErrorMessage
forall a. Semigroup a => a -> a -> a
<> Event -> GErrorMessage
forall a. Show a => a -> GErrorMessage
showT Event
ev
    Just e :: Event
e -> [Event] -> IO ()
ch [Event
e]
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

gtkToYiEvent :: Gdk.Events.Event -> Maybe Event
gtkToYiEvent :: Event -> Maybe Event
gtkToYiEvent (Gdk.Events.Key {eventKeyName :: Event -> GErrorMessage
Gdk.Events.eventKeyName = GErrorMessage
key
                             , eventModifier :: Event -> [Modifier]
Gdk.Events.eventModifier = [Modifier]
evModifier
                             , eventKeyChar :: Event -> Maybe Char
Gdk.Events.eventKeyChar = Maybe Char
char})
    = (\k :: Key
k -> Key -> [Modifier] -> Event
Event Key
k ([Modifier] -> Event) -> [Modifier] -> Event
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
notMShift ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ (Modifier -> [Modifier]) -> [Modifier] -> [Modifier]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Modifier -> [Modifier]
modif [Modifier]
evModifier) (Key -> Event) -> Maybe Key -> Maybe Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Key
key'
      where (key' :: Maybe Key
key',isShift :: Bool
isShift) =
                case Maybe Char
char of
                  Just c :: Char
c  -> (Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> Key -> Maybe Key
forall a b. (a -> b) -> a -> b
$ Char -> Key
KASCII Char
c, Bool
True)
                  Nothing -> (GErrorMessage -> Map GErrorMessage Key -> Maybe Key
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GErrorMessage
key Map GErrorMessage Key
keyTable, Bool
False)
            modif :: Modifier -> [Modifier]
modif Gdk.Events.Control = [Modifier
MCtrl]
            modif Gdk.Events.Alt     = [Modifier
MMeta]
            modif Gdk.Events.Shift   = [Modifier
MShift]
            modif _ = []
            notMShift :: [Modifier] -> [Modifier]
notMShift | Bool
isShift   = (Modifier -> Bool) -> [Modifier] -> [Modifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (Modifier -> Modifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Modifier
MShift)
                      | Bool
otherwise = [Modifier] -> [Modifier]
forall a. a -> a
id
gtkToYiEvent _ = Maybe Event
forall a. Maybe a
Nothing

-- | Map GTK long names to Keys
keyTable :: Map.Map Text Key
keyTable :: Map GErrorMessage Key
keyTable = [(GErrorMessage, Key)] -> Map GErrorMessage Key
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [("Down",       Key
KDown)
    ,("Up",         Key
KUp)
    ,("Left",       Key
KLeft)
    ,("Right",      Key
KRight)
    ,("Home",       Key
KHome)
    ,("End",        Key
KEnd)
    ,("BackSpace",  Key
KBS)
    ,("Delete",     Key
KDel)
    ,("Page_Up",    Key
KPageUp)
    ,("Page_Down",  Key
KPageDown)
    ,("Insert",     Key
KIns)
    ,("Escape",     Key
KEsc)
    ,("Return",     Key
KEnter)
    ,("Tab",        Key
KTab)
    ,("ISO_Left_Tab", Key
KTab)
    ]