{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Frontend.Pango (start, startGtkHook) where
import Control.Applicative
import Control.Concurrent
import Control.Exception (catch, SomeException)
import Lens.Micro.Platform hiding (set)
import Control.Monad hiding (forM_, mapM_, forM, mapM)
import Data.Foldable
import Data.IORef
import qualified Data.List.PointedList as PL (moveTo)
import qualified Data.List.PointedList.Circular as PL
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import Data.Text (unpack, Text)
import qualified Data.Text as T
import Data.Traversable
import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk hiding (Region, Window, Action , Point,
Style, Modifier, on)
import qualified Graphics.UI.Gtk.Gdk.EventM as EventM
import qualified Graphics.UI.Gtk.Gdk.GC as Gtk
import Graphics.UI.Gtk.Gdk.GC hiding (foreground)
import Prelude hiding (error, elem, mapM_, foldl, concat, mapM)
import System.Glib.GError
import Yi.Buffer
import Yi.Config
import Yi.Debug
import Yi.Editor
import Yi.Event
import Yi.Keymap
import Yi.Layout(DividerPosition, DividerRef)
import Yi.Monad
import qualified Yi.Rope as R
import Yi.Style
import Yi.Tab
import Yi.Types (fontsizeVariation, attributes)
import qualified Yi.UI.Common as Common
import Yi.Frontend.Pango.Control (keyTable)
import Yi.Frontend.Pango.Layouts
import Yi.Frontend.Pango.Utils
import Yi.String (showT)
import Yi.UI.TabBar
import Yi.UI.Utils
import Yi.Utils
import Yi.Window
data UI = UI
{ UI -> Window
uiWindow :: Gtk.Window
, UI -> SimpleNotebook
uiNotebook :: SimpleNotebook
, UI -> Statusbar
uiStatusbar :: Statusbar
, UI -> IORef TabCache
tabCache :: IORef TabCache
, UI -> Action -> IO ()
uiActionCh :: Action -> IO ()
, UI -> UIConfig
uiConfig :: UIConfig
, UI -> IORef FontDescription
uiFont :: IORef FontDescription
, UI -> IMContext
uiInput :: IMContext
}
type TabCache = PL.PointedList TabInfo
type WindowCache = M.Map WindowRef WinInfo
data TabInfo = TabInfo
{ TabInfo -> TabRef
coreTabKey :: TabRef
, TabInfo -> LayoutDisplay
layoutDisplay :: LayoutDisplay
, TabInfo -> MiniwindowDisplay
miniwindowPage :: MiniwindowDisplay
, TabInfo -> Widget
tabWidget :: Widget
, TabInfo -> IORef WindowCache
windowCache :: IORef WindowCache
, TabInfo -> IORef Text
fullTitle :: IORef Text
, TabInfo -> IORef Text
abbrevTitle :: IORef Text
}
instance Show TabInfo where
show :: TabInfo -> String
show t :: TabInfo
t = TabRef -> String
forall a. Show a => a -> String
show (TabInfo -> TabRef
coreTabKey TabInfo
t)
data WinInfo = WinInfo
{ WinInfo -> WindowRef
coreWinKey :: WindowRef
, WinInfo -> IORef Window
coreWin :: IORef Window
, WinInfo -> IORef Point
shownTos :: IORef Point
, WinInfo -> IORef Bool
lButtonPressed :: IORef Bool
, WinInfo -> IORef Bool
insertingMode :: IORef Bool
, WinInfo -> IORef Bool
inFocus :: IORef Bool
, WinInfo -> MVar WinLayoutInfo
winLayoutInfo :: MVar WinLayoutInfo
, WinInfo -> FontMetrics
winMetrics :: FontMetrics
, WinInfo -> DrawingArea
textview :: DrawingArea
, WinInfo -> Label
modeline :: Label
, WinInfo -> Widget
winWidget :: Widget
}
data WinLayoutInfo = WinLayoutInfo {
WinLayoutInfo -> PangoLayout
winLayout :: !PangoLayout,
WinLayoutInfo -> Point
tos :: !Point,
WinLayoutInfo -> Point
bos :: !Point,
WinLayoutInfo -> Point
bufEnd :: !Point,
WinLayoutInfo -> Point
cur :: !Point,
WinLayoutInfo -> FBuffer
buffer :: !FBuffer,
WinLayoutInfo -> Maybe SearchExp
regex :: !(Maybe SearchExp)
}
instance Show WinInfo where
show :: WinInfo -> String
show w :: WinInfo
w = WindowRef -> String
forall a. Show a => a -> String
show (WinInfo -> WindowRef
coreWinKey WinInfo
w)
instance Ord EventM.Modifier where
x :: Modifier
x <= :: Modifier -> Modifier -> Bool
<= y :: Modifier
y = Modifier -> TabRef
forall a. Enum a => a -> TabRef
fromEnum Modifier
x TabRef -> TabRef -> Bool
forall a. Ord a => a -> a -> Bool
<= Modifier -> TabRef
forall a. Enum a => a -> TabRef
fromEnum Modifier
y
mkUI :: UI -> Common.UI Editor
mkUI :: UI -> UI Editor
mkUI ui :: UI
ui = UI Any
forall e. UI e
Common.dummyUI
{ main :: IO ()
Common.main = IO ()
main
, end :: Maybe ExitCode -> IO ()
Common.end = IO () -> Maybe ExitCode -> IO ()
forall a b. a -> b -> a
const IO ()
end
, suspend :: IO ()
Common.suspend = Window -> IO ()
forall self. WindowClass self => self -> IO ()
windowIconify (UI -> Window
uiWindow UI
ui)
, refresh :: Editor -> IO ()
Common.refresh = UI -> Editor -> IO ()
refresh UI
ui
, layout :: Editor -> IO Editor
Common.layout = UI -> Editor -> IO Editor
doLayout UI
ui
, reloadProject :: String -> IO ()
Common.reloadProject = IO () -> String -> IO ()
forall a b. a -> b -> a
const IO ()
reloadProject
}
updateFont :: UIConfig -> IORef FontDescription -> IORef TabCache -> Statusbar
-> FontDescription -> IO ()
updateFont :: UIConfig
-> IORef FontDescription
-> IORef TabCache
-> Statusbar
-> FontDescription
-> IO ()
updateFont cfg :: UIConfig
cfg fontRef :: IORef FontDescription
fontRef tc :: IORef TabCache
tc status :: Statusbar
status font :: FontDescription
font = do
IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FontDescription -> String -> IO ()
forall string.
GlibString string =>
FontDescription -> string -> IO ()
fontDescriptionSetFamily FontDescription
font) (UIConfig -> Maybe String
configFontName UIConfig
cfg)
IORef FontDescription -> FontDescription -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef FontDescription
fontRef FontDescription
font
Statusbar -> Maybe FontDescription -> IO ()
forall self.
WidgetClass self =>
self -> Maybe FontDescription -> IO ()
widgetModifyFont Statusbar
status (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
font)
TabCache
tcs <- IORef TabCache -> IO TabCache
forall a. IORef a -> IO a
readIORef IORef TabCache
tc
TabCache -> (TabInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ TabCache
tcs ((TabInfo -> IO ()) -> IO ()) -> (TabInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \tabinfo :: TabInfo
tabinfo -> do
WindowCache
wcs <- IORef WindowCache -> IO WindowCache
forall a. IORef a -> IO a
readIORef (TabInfo -> IORef WindowCache
windowCache TabInfo
tabinfo)
WindowCache -> (WinInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ WindowCache
wcs ((WinInfo -> IO ()) -> IO ()) -> (WinInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \wininfo :: WinInfo
wininfo -> do
MVar WinLayoutInfo -> (WinLayoutInfo -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (WinInfo -> MVar WinLayoutInfo
winLayoutInfo WinInfo
wininfo) ((WinLayoutInfo -> IO ()) -> IO ())
-> (WinLayoutInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WinLayoutInfo{PangoLayout
winLayout :: PangoLayout
winLayout :: WinLayoutInfo -> PangoLayout
winLayout} ->
PangoLayout -> Maybe FontDescription -> IO ()
layoutSetFontDescription PangoLayout
winLayout (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
font)
DrawingArea -> Maybe FontDescription -> IO ()
forall self.
WidgetClass self =>
self -> Maybe FontDescription -> IO ()
widgetModifyFont (WinInfo -> DrawingArea
textview WinInfo
wininfo) (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
font)
Label -> Maybe FontDescription -> IO ()
forall self.
WidgetClass self =>
self -> Maybe FontDescription -> IO ()
widgetModifyFont (WinInfo -> Label
modeline WinInfo
wininfo) (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
font)
askBuffer :: 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
start :: UIBoot
start :: UIBoot
start = (Window -> IO ()) -> UIBoot
startGtkHook (IO () -> Window -> IO ()
forall a b. a -> b -> a
const (IO () -> Window -> IO ()) -> IO () -> Window -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
startGtkHook :: (Gtk.Window -> IO ()) -> UIBoot
startGtkHook :: (Window -> IO ()) -> UIBoot
startGtkHook userHook :: Window -> IO ()
userHook 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 ((Window -> IO ()) -> UIBoot
startNoMsgGtkHook Window -> IO ()
userHook Config
cfg [Event] -> IO ()
ch [Action] -> IO ()
outCh Editor
ed)
(\(GError _dom :: GErrorDomain
_dom _code :: TabRef
_code msg :: Text
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
$ Text -> String
unpack Text
msg)
startNoMsgGtkHook :: (Gtk.Window -> IO ()) -> UIBoot
startNoMsgGtkHook :: (Window -> IO ()) -> UIBoot
startNoMsgGtkHook userHook :: Window -> IO ()
userHook cfg :: Config
cfg ch :: [Event] -> IO ()
ch outCh :: [Action] -> IO ()
outCh ed :: Editor
ed = do
Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn "startNoMsgGtkHook"
IO [String] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO [String]
unsafeInitGUIForThreadedRTS
Window
win <- IO Window
windowNew
Pixbuf
ico <- String -> IO Pixbuf
loadIcon "yi+lambda-fat-32.png"
VBox
vb <- Bool -> TabRef -> IO VBox
vBoxNew Bool
False 1
IMContext
im <- IO IMContext
imMulticontextNew
IMContext -> Bool -> IO ()
forall self. IMContextClass self => self -> Bool -> IO ()
imContextSetUsePreedit IMContext
im Bool
False
let imContextCommitS :: Signal IMContext (String -> IO ())
imContextCommitS :: Signal IMContext (String -> IO ())
imContextCommitS = Signal IMContext (String -> IO ())
forall self string.
(IMContextClass self, GlibString string) =>
Signal self (string -> IO ())
imContextCommit
IMContext
im IMContext
-> Signal IMContext (String -> IO ()) -> (String -> IO ()) -> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal IMContext (String -> IO ())
imContextCommitS ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char -> IO ()) -> String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\k :: Char
k -> [Event] -> IO ()
ch [Key -> [Modifier] -> Event
Event (Char -> Key
KASCII Char
k) []])
Window -> [AttrOp Window] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set Window
win [ Attr Window TabRef
forall self. WindowClass self => Attr self TabRef
windowDefaultWidth Attr Window TabRef -> TabRef -> AttrOp Window
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= 700
, Attr Window TabRef
forall self. WindowClass self => Attr self TabRef
windowDefaultHeight Attr Window TabRef -> TabRef -> AttrOp Window
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= 900
, Attr Window Text
forall self string.
(WindowClass self, GlibString string) =>
Attr self string
windowTitle Attr Window Text -> Text -> AttrOp Window
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= ("Yi" :: T.Text)
, Attr Window (Maybe Pixbuf)
forall self. WindowClass self => Attr self (Maybe Pixbuf)
windowIcon Attr Window (Maybe Pixbuf) -> Maybe Pixbuf -> AttrOp Window
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Pixbuf -> Maybe Pixbuf
forall a. a -> Maybe a
Just Pixbuf
ico
, WriteAttr Window VBox
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr Window VBox -> VBox -> AttrOp Window
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= VBox
vb
]
Window
win Window
-> Signal Window (EventM EAny Bool) -> EventM EAny Bool -> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal Window (EventM EAny Bool)
forall self. WidgetClass self => Signal self (EventM EAny Bool)
deleteEvent (EventM EAny Bool -> IO ()) -> EventM EAny Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> EventM EAny Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> EventM EAny Bool) -> IO Bool -> EventM EAny Bool
forall a b. (a -> b) -> a -> b
$ IO ()
mainQuit IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Window
win Window
-> Signal Window (EventM EKey Bool) -> EventM EKey Bool -> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal Window (EventM EKey Bool)
forall self. WidgetClass self => Signal self (EventM EKey Bool)
keyPressEvent (EventM EKey Bool -> IO ()) -> EventM EKey Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ ([Event] -> IO ()) -> IMContext -> EventM EKey Bool
handleKeypress [Event] -> IO ()
ch IMContext
im
HPaned
paned <- IO HPaned
hPanedNew
SimpleNotebook
tabs <- IO SimpleNotebook
simpleNotebookNew
HPaned -> Widget -> IO ()
forall self child.
(PanedClass self, WidgetClass child) =>
self -> child -> IO ()
panedAdd2 HPaned
paned (SimpleNotebook -> Widget
forall w. WidgetLike w => w -> Widget
baseWidget SimpleNotebook
tabs)
Statusbar
status <- IO Statusbar
statusbarNew
Statusbar -> IO Box
forall self. StatusbarClass self => self -> IO Box
statusbarGetMessageArea Statusbar
status IO Box -> (Box -> IO [Widget]) -> IO [Widget]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Box -> IO [Widget]
forall self. ContainerClass self => self -> IO [Widget]
containerGetChildren IO [Widget] -> ([Widget] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[w :: Widget
w] -> Label -> Bool -> IO ()
forall self. LabelClass self => self -> Bool -> IO ()
labelSetSingleLineMode (Widget -> Label
forall obj. GObjectClass obj => obj -> Label
castToLabel Widget
w) Bool
False
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
VBox -> [AttrOp VBox] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set VBox
vb [ WriteAttr VBox HPaned
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr VBox HPaned -> HPaned -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= HPaned
paned
, WriteAttr VBox Statusbar
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr VBox Statusbar -> Statusbar -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Statusbar
status
, Statusbar -> Attr VBox Packing
forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking Statusbar
status Attr VBox Packing -> Packing -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Packing
PackNatural
]
IORef FontDescription
fontRef <- IO FontDescription
fontDescriptionNew IO FontDescription
-> (FontDescription -> IO (IORef FontDescription))
-> IO (IORef FontDescription)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FontDescription -> IO (IORef FontDescription)
forall a. a -> IO (IORef a)
newIORef
let actionCh :: Action -> IO ()
actionCh = [Action] -> IO ()
outCh ([Action] -> IO ()) -> (Action -> [Action]) -> Action -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action -> [Action]
forall (m :: * -> *) a. Monad m => a -> m a
return
IORef TabCache
tc <- TabCache -> IO (IORef TabCache)
forall a. a -> IO (IORef a)
newIORef (TabCache -> IO (IORef TabCache))
-> IO TabCache -> IO (IORef TabCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Editor -> (Action -> IO ()) -> IO TabCache
newCache Editor
ed Action -> IO ()
actionCh
let watchFont :: (FontDescription -> IO b) -> IO b
watchFont = (Text -> IO FontDescription
forall string. GlibString string => string -> IO FontDescription
fontDescriptionFromString ("Monospace 10" :: T.Text) IO FontDescription -> (FontDescription -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
(FontDescription -> IO ()) -> IO ()
forall b. (FontDescription -> IO b) -> IO b
watchFont ((FontDescription -> IO ()) -> IO ())
-> (FontDescription -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ UIConfig
-> IORef FontDescription
-> IORef TabCache
-> Statusbar
-> FontDescription
-> IO ()
updateFont (Config -> UIConfig
configUI Config
cfg) IORef FontDescription
fontRef IORef TabCache
tc Statusbar
status
Window -> IO ()
userHook Window
win
IO GErrorDomain -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO GErrorDomain -> IO ()) -> IO GErrorDomain -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> TabRef -> TabRef -> IO GErrorDomain
timeoutAddFull (IO ()
yield IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) TabRef
priorityDefaultIdle 50
Window -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetShowAll Window
win
let ui :: UI
ui = Window
-> SimpleNotebook
-> Statusbar
-> IORef TabCache
-> (Action -> IO ())
-> UIConfig
-> IORef FontDescription
-> IMContext
-> UI
UI Window
win SimpleNotebook
tabs Statusbar
status IORef TabCache
tc Action -> IO ()
actionCh (Config -> UIConfig
configUI Config
cfg) IORef FontDescription
fontRef IMContext
im
let move :: TabRef -> PointedList a -> PointedList a
move n :: TabRef
n pl :: PointedList a
pl = PointedList a -> Maybe (PointedList a) -> PointedList a
forall a. a -> Maybe a -> a
fromMaybe PointedList a
pl (TabRef -> PointedList a -> Maybe (PointedList a)
forall a. TabRef -> PointedList a -> Maybe (PointedList a)
PL.moveTo TabRef
n PointedList a
pl)
runAction :: EditorM () -> IO ()
runAction = UI -> Action -> IO ()
uiActionCh UI
ui (Action -> IO ()) -> (EditorM () -> Action) -> EditorM () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction
SimpleNotebook -> (TabRef -> IO ()) -> IO ()
simpleNotebookOnSwitchPage (UI -> SimpleNotebook
uiNotebook UI
ui) ((TabRef -> IO ()) -> IO ()) -> (TabRef -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \n :: TabRef
n -> IO () -> IO ()
postGUIAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
EditorM () -> IO ()
runAction (ASetter Editor Editor (PointedList Tab) (PointedList Tab)
-> (PointedList Tab -> PointedList Tab) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
(%=) ASetter Editor Editor (PointedList Tab) (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA (TabRef -> PointedList Tab -> PointedList Tab
forall a. TabRef -> PointedList a -> PointedList a
move TabRef
n) :: EditorM ())
UI Editor -> IO (UI Editor)
forall (m :: * -> *) a. Monad m => a -> m a
return (UI -> UI Editor
mkUI UI
ui)
main :: IO ()
main :: IO ()
main = Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn "GTK main loop running" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
mainGUI
end :: IO ()
end :: IO ()
end = IO ()
mainQuit
updateCache :: UI -> Editor -> IO ()
updateCache :: UI -> Editor -> IO ()
updateCache ui :: UI
ui e :: Editor
e = do
TabCache
cache <- IORef TabCache -> IO TabCache
forall a. IORef a -> IO a
readIORef (IORef TabCache -> IO TabCache) -> IORef TabCache -> IO TabCache
forall a b. (a -> b) -> a -> b
$ UI -> IORef TabCache
tabCache UI
ui
let cacheMap :: Map TabRef TabInfo
cacheMap = PointedList (TabRef, TabInfo) -> Map TabRef TabInfo
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
t (k, a) -> Map k a
mapFromFoldable (PointedList (TabRef, TabInfo) -> Map TabRef TabInfo)
-> (TabCache -> PointedList (TabRef, TabInfo))
-> TabCache
-> Map TabRef TabInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TabInfo -> (TabRef, TabInfo))
-> TabCache -> PointedList (TabRef, TabInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :: TabInfo
t -> (TabInfo -> TabRef
coreTabKey TabInfo
t, TabInfo
t)) (TabCache -> Map TabRef TabInfo) -> TabCache -> Map TabRef TabInfo
forall a b. (a -> b) -> a -> b
$ TabCache
cache
TabCache
cache' <- PointedList Tab -> (Tab -> IO TabInfo) -> IO TabCache
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (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) ((Tab -> IO TabInfo) -> IO TabCache)
-> (Tab -> IO TabInfo) -> IO TabCache
forall a b. (a -> b) -> a -> b
$ \tab :: Tab
tab ->
case TabRef -> Map TabRef TabInfo -> Maybe TabInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Tab -> TabRef
tkey Tab
tab) Map TabRef TabInfo
cacheMap of
Just t :: TabInfo
t -> Editor -> UI -> Tab -> TabInfo -> IO ()
updateTabInfo Editor
e UI
ui Tab
tab TabInfo
t IO () -> IO TabInfo -> IO TabInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TabInfo -> IO TabInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TabInfo
t
Nothing -> Editor -> UI -> Tab -> IO TabInfo
newTab Editor
e UI
ui Tab
tab
IORef TabCache -> TabCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (UI -> IORef TabCache
tabCache UI
ui) TabCache
cache'
SimpleNotebook -> PointedList (Widget, Text) -> IO ()
simpleNotebookSet (UI -> SimpleNotebook
uiNotebook UI
ui)
(PointedList (Widget, Text) -> IO ())
-> IO (PointedList (Widget, Text)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TabCache
-> (TabInfo -> IO (Widget, Text))
-> IO (PointedList (Widget, Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM TabCache
cache' (\t :: TabInfo
t -> (TabInfo -> Widget
tabWidget TabInfo
t,) (Text -> (Widget, Text)) -> IO Text -> IO (Widget, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef (TabInfo -> IORef Text
abbrevTitle TabInfo
t))
updateTabInfo :: Editor -> UI -> Tab -> TabInfo -> IO ()
updateTabInfo :: Editor -> UI -> Tab -> TabInfo -> IO ()
updateTabInfo e :: Editor
e ui :: UI
ui tab :: Tab
tab tabInfo :: TabInfo
tabInfo = do
WindowCache
wCacheOld <- IORef WindowCache -> IO WindowCache
forall a. IORef a -> IO a
readIORef (TabInfo -> IORef WindowCache
windowCache TabInfo
tabInfo)
WindowCache
wCacheNew <- PointedList (WindowRef, WinInfo) -> WindowCache
forall (t :: * -> *) k a.
(Foldable t, Ord k) =>
t (k, a) -> Map k a
mapFromFoldable (PointedList (WindowRef, WinInfo) -> WindowCache)
-> IO (PointedList (WindowRef, WinInfo)) -> IO WindowCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PointedList Window
-> (Window -> IO (WindowRef, WinInfo))
-> IO (PointedList (WindowRef, WinInfo))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Tab
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) (\w :: Window
w ->
case WindowRef -> WindowCache -> Maybe WinInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Window -> WindowRef
wkey Window
w) WindowCache
wCacheOld of
Just wInfo :: WinInfo
wInfo -> Editor -> UI -> Window -> WinInfo -> IO ()
updateWindow Editor
e UI
ui Window
w WinInfo
wInfo IO () -> IO (WindowRef, WinInfo) -> IO (WindowRef, WinInfo)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowRef, WinInfo) -> IO (WindowRef, WinInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Window -> WindowRef
wkey Window
w, WinInfo
wInfo)
Nothing -> (Window -> WindowRef
wkey Window
w,) (WinInfo -> (WindowRef, WinInfo))
-> IO WinInfo -> IO (WindowRef, WinInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor -> UI -> Window -> IO WinInfo
newWindow Editor
e UI
ui Window
w)
IORef WindowCache -> WindowCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TabInfo -> IORef WindowCache
windowCache TabInfo
tabInfo) WindowCache
wCacheNew
let lookupWin :: WindowRef -> WinInfo
lookupWin w :: WindowRef
w = WindowCache
wCacheNew WindowCache -> WindowRef -> WinInfo
forall k a. Ord k => Map k a -> k -> a
M.! WindowRef
w
LayoutDisplay -> Layout Widget -> IO ()
layoutDisplaySet (TabInfo -> LayoutDisplay
layoutDisplay TabInfo
tabInfo)
(Layout Widget -> IO ()) -> (Tab -> Layout Widget) -> Tab -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowRef -> Widget) -> Layout WindowRef -> Layout Widget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WinInfo -> Widget
winWidget (WinInfo -> Widget)
-> (WindowRef -> WinInfo) -> WindowRef -> Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowRef -> WinInfo
lookupWin) (Layout WindowRef -> Layout Widget)
-> (Tab -> Layout WindowRef) -> Tab -> Layout Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tab -> Layout WindowRef
tabLayout (Tab -> IO ()) -> Tab -> IO ()
forall a b. (a -> b) -> a -> b
$ Tab
tab
MiniwindowDisplay -> [Widget] -> IO ()
miniwindowDisplaySet (TabInfo -> MiniwindowDisplay
miniwindowPage TabInfo
tabInfo)
([Widget] -> IO ()) -> (Tab -> [Widget]) -> Tab -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Widget) -> [Window] -> [Widget]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WinInfo -> Widget
winWidget (WinInfo -> Widget) -> (Window -> WinInfo) -> Window -> Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowRef -> WinInfo
lookupWin (WindowRef -> WinInfo)
-> (Window -> WindowRef) -> Window -> WinInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowRef
wkey) ([Window] -> [Widget]) -> (Tab -> [Window]) -> Tab -> [Widget]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tab -> [Window]
tabMiniWindows (Tab -> IO ()) -> Tab -> IO ()
forall a b. (a -> b) -> a -> b
$ Tab
tab
Editor -> UI -> TabInfo -> WinInfo -> IO ()
setWindowFocus Editor
e UI
ui TabInfo
tabInfo (WinInfo -> IO ()) -> (Tab -> WinInfo) -> Tab -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowRef -> WinInfo
lookupWin (WindowRef -> WinInfo) -> (Tab -> WindowRef) -> Tab -> WinInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowRef
wkey (Window -> WindowRef) -> (Tab -> Window) -> Tab -> WindowRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tab -> Window
tabFocus (Tab -> IO ()) -> Tab -> IO ()
forall a b. (a -> b) -> a -> b
$ Tab
tab
updateWindow :: Editor -> UI -> Window -> WinInfo -> IO ()
updateWindow :: Editor -> UI -> Window -> WinInfo -> IO ()
updateWindow e :: Editor
e _ui :: UI
_ui win :: Window
win wInfo :: WinInfo
wInfo = do
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (WinInfo -> IORef Bool
inFocus WinInfo
wInfo) Bool
False
IORef Window -> Window -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (WinInfo -> IORef Window
coreWin WinInfo
wInfo) Window
win
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (WinInfo -> IORef Bool
insertingMode WinInfo
wInfo)
(Window -> FBuffer -> BufferM Bool -> Bool
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
win (BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e) (BufferM Bool -> Bool) -> BufferM Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
insertingA)
setWindowFocus :: Editor -> UI -> TabInfo -> WinInfo -> IO ()
setWindowFocus :: Editor -> UI -> TabInfo -> WinInfo -> IO ()
setWindowFocus e :: Editor
e ui :: UI
ui t :: TabInfo
t w :: WinInfo
w = do
Window
win <- IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
w)
let bufferName :: Text
bufferName = TabRef -> FBuffer -> Text
shortIdentString ([String] -> TabRef
forall (t :: * -> *) a. Foldable t => t a -> TabRef
length ([String] -> TabRef) -> [String] -> TabRef
forall a b. (a -> b) -> a -> b
$ Editor -> [String]
commonNamePrefix Editor
e) (FBuffer -> Text) -> FBuffer -> Text
forall a b. (a -> b) -> a -> b
$
BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e
ml :: Text
ml = Window -> FBuffer -> BufferM Text -> Text
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
win (BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e) (BufferM Text -> Text) -> BufferM Text -> Text
forall a b. (a -> b) -> a -> b
$
[Text] -> BufferM Text
getModeLine (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor -> [String]
commonNamePrefix Editor
e)
im :: IMContext
im = UI -> IMContext
uiInput UI
ui
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (WinInfo -> IORef Bool
inFocus WinInfo
w) Bool
True
DrawingArea -> ReadWriteAttr DrawingArea Bool Bool -> Bool -> IO ()
forall a o. Eq a => o -> ReadWriteAttr o a a -> a -> IO ()
update (WinInfo -> DrawingArea
textview WinInfo
w) ReadWriteAttr DrawingArea Bool Bool
forall self. WidgetClass self => Attr self Bool
widgetIsFocus Bool
True
Label -> ReadWriteAttr Label Text Text -> Text -> IO ()
forall a o. Eq a => o -> ReadWriteAttr o a a -> a -> IO ()
update (WinInfo -> Label
modeline WinInfo
w) ReadWriteAttr Label Text Text
forall self string.
(LabelClass self, GlibString string) =>
Attr self string
labelText Text
ml
IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TabInfo -> IORef Text
fullTitle TabInfo
t) Text
bufferName
IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TabInfo -> IORef Text
abbrevTitle TabInfo
t) (Text -> Text
tabAbbrevTitle Text
bufferName)
Maybe DrawWindow
drawW <- IO (Maybe DrawWindow)
-> (SomeException -> IO (Maybe DrawWindow))
-> IO (Maybe DrawWindow)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch ((DrawWindow -> Maybe DrawWindow)
-> IO DrawWindow -> IO (Maybe DrawWindow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DrawWindow -> Maybe DrawWindow
forall a. a -> Maybe a
Just (IO DrawWindow -> IO (Maybe DrawWindow))
-> IO DrawWindow -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$ DrawingArea -> IO DrawWindow
forall widget. WidgetClass widget => widget -> IO DrawWindow
widgetGetDrawWindow (DrawingArea -> IO DrawWindow) -> DrawingArea -> IO DrawWindow
forall a b. (a -> b) -> a -> b
$ WinInfo -> DrawingArea
textview WinInfo
w)
(\(SomeException
_ :: SomeException) -> Maybe DrawWindow -> IO (Maybe DrawWindow)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DrawWindow
forall a. Maybe a
Nothing)
IMContext -> Maybe DrawWindow -> IO ()
forall self.
IMContextClass self =>
self -> Maybe DrawWindow -> IO ()
imContextSetClientWindow IMContext
im Maybe DrawWindow
drawW
IMContext -> IO ()
forall self. IMContextClass self => self -> IO ()
imContextFocusIn IMContext
im
getWinInfo :: UI -> WindowRef -> IO WinInfo
getWinInfo :: UI -> WindowRef -> IO WinInfo
getWinInfo ui :: UI
ui ref :: WindowRef
ref =
let tabLoop :: [TabInfo] -> IO WinInfo
tabLoop [] = Text -> IO WinInfo
forall a. Text -> a
error "Yi.UI.Pango.getWinInfo: window not found"
tabLoop (t :: TabInfo
t:ts :: [TabInfo]
ts) = do
WindowCache
wCache <- IORef WindowCache -> IO WindowCache
forall a. IORef a -> IO a
readIORef (TabInfo -> IORef WindowCache
windowCache TabInfo
t)
case WindowRef -> WindowCache -> Maybe WinInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WindowRef
ref WindowCache
wCache of
Just w :: WinInfo
w -> WinInfo -> IO WinInfo
forall (m :: * -> *) a. Monad m => a -> m a
return WinInfo
w
Nothing -> [TabInfo] -> IO WinInfo
tabLoop [TabInfo]
ts
in IORef TabCache -> IO TabCache
forall a. IORef a -> IO a
readIORef (UI -> IORef TabCache
tabCache UI
ui) IO TabCache -> (TabCache -> IO WinInfo) -> IO WinInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([TabInfo] -> IO WinInfo
tabLoop ([TabInfo] -> IO WinInfo)
-> (TabCache -> [TabInfo]) -> TabCache -> IO WinInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TabCache -> [TabInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
newCache :: Editor -> (Action -> IO ()) -> IO TabCache
newCache :: Editor -> (Action -> IO ()) -> IO TabCache
newCache e :: Editor
e actionCh :: Action -> IO ()
actionCh = (Tab -> IO TabInfo) -> PointedList Tab -> IO TabCache
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Action -> IO ()) -> Tab -> IO TabInfo
mkDummyTab Action -> IO ()
actionCh) (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)
newTab :: Editor -> UI -> Tab -> IO TabInfo
newTab :: Editor -> UI -> Tab -> IO TabInfo
newTab e :: Editor
e ui :: UI
ui tab :: Tab
tab = do
TabInfo
t <- (Action -> IO ()) -> Tab -> IO TabInfo
mkDummyTab (UI -> Action -> IO ()
uiActionCh UI
ui) Tab
tab
Editor -> UI -> Tab -> TabInfo -> IO ()
updateTabInfo Editor
e UI
ui Tab
tab TabInfo
t
TabInfo -> IO TabInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TabInfo
t
mkDummyTab :: (Action -> IO ()) -> Tab -> IO TabInfo
mkDummyTab :: (Action -> IO ()) -> Tab -> IO TabInfo
mkDummyTab actionCh :: Action -> IO ()
actionCh tab :: Tab
tab = do
IORef WindowCache
ws <- WindowCache -> IO (IORef WindowCache)
forall a. a -> IO (IORef a)
newIORef WindowCache
forall k a. Map k a
M.empty
LayoutDisplay
ld <- IO LayoutDisplay
layoutDisplayNew
LayoutDisplay -> (TabRef -> DividerPosition -> IO ()) -> IO ()
layoutDisplayOnDividerMove LayoutDisplay
ld ((Action -> IO ()) -> TabRef -> DividerPosition -> IO ()
handleDividerMove Action -> IO ()
actionCh)
MiniwindowDisplay
mwp <- IO MiniwindowDisplay
miniwindowDisplayNew
VBox
tw <- Bool -> TabRef -> IO VBox
vBoxNew Bool
False 0
VBox -> [AttrOp VBox] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set VBox
tw [WriteAttr VBox Widget
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr VBox Widget -> Widget -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= LayoutDisplay -> Widget
forall w. WidgetLike w => w -> Widget
baseWidget LayoutDisplay
ld,
WriteAttr VBox Widget
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr VBox Widget -> Widget -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= MiniwindowDisplay -> Widget
forall w. WidgetLike w => w -> Widget
baseWidget MiniwindowDisplay
mwp,
Widget -> Attr VBox Packing
forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking (LayoutDisplay -> Widget
forall w. WidgetLike w => w -> Widget
baseWidget LayoutDisplay
ld) Attr VBox Packing -> Packing -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Packing
PackGrow,
Widget -> Attr VBox Packing
forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking (MiniwindowDisplay -> Widget
forall w. WidgetLike w => w -> Widget
baseWidget MiniwindowDisplay
mwp) Attr VBox Packing -> Packing -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Packing
PackNatural]
IORef Text
ftRef <- Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef ""
IORef Text
atRef <- Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef ""
TabInfo -> IO TabInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (TabRef
-> LayoutDisplay
-> MiniwindowDisplay
-> Widget
-> IORef WindowCache
-> IORef Text
-> IORef Text
-> TabInfo
TabInfo (Tab -> TabRef
tkey Tab
tab) LayoutDisplay
ld MiniwindowDisplay
mwp (VBox -> Widget
forall o. WidgetClass o => o -> Widget
toWidget VBox
tw) IORef WindowCache
ws IORef Text
ftRef IORef Text
atRef)
newWindow :: Editor -> UI -> Window -> IO WinInfo
newWindow :: Editor -> UI -> Window -> IO WinInfo
newWindow e :: Editor
e ui :: UI
ui w :: Window
w = do
let b :: FBuffer
b = BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
w) Editor
e
FontDescription
f <- IORef FontDescription -> IO FontDescription
forall a. IORef a -> IO a
readIORef (UI -> IORef FontDescription
uiFont UI
ui)
Label
ml <- Maybe Text -> IO Label
forall string. GlibString string => Maybe string -> IO Label
labelNew (Maybe Text
forall a. Maybe a
Nothing :: Maybe Text)
Label -> Maybe FontDescription -> IO ()
forall self.
WidgetClass self =>
self -> Maybe FontDescription -> IO ()
widgetModifyFont Label
ml (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
f)
Label -> [AttrOp Label] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set Label
ml [ Attr Label Float
forall self. MiscClass self => Attr self Float
miscXalign Attr Label Float -> Float -> AttrOp Label
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= 0.01 ]
Label -> TabRef -> TabRef -> IO ()
forall self. WidgetClass self => self -> TabRef -> TabRef -> IO ()
widgetSetSizeRequest Label
ml 0 (-1)
DrawingArea
v <- IO DrawingArea
drawingAreaNew
DrawingArea -> Maybe FontDescription -> IO ()
forall self.
WidgetClass self =>
self -> Maybe FontDescription -> IO ()
widgetModifyFont DrawingArea
v (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
f)
DrawingArea -> [EventMask] -> IO ()
forall self. WidgetClass self => self -> [EventMask] -> IO ()
widgetAddEvents DrawingArea
v [EventMask
Button1MotionMask]
DrawingArea -> StateType -> Color -> IO ()
forall self.
WidgetClass self =>
self -> StateType -> Color -> IO ()
widgetModifyBg DrawingArea
v 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 -> IO ()) -> UIConfig -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> UIConfig
uiConfig UI
ui
ScrolledWindow
sw <- Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
scrolledWindowNew Maybe Adjustment
forall a. Maybe a
Nothing Maybe Adjustment
forall a. Maybe a
Nothing
ScrolledWindow -> DrawingArea -> IO ()
forall self child.
(ScrolledWindowClass self, WidgetClass child) =>
self -> child -> IO ()
scrolledWindowAddWithViewport ScrolledWindow
sw DrawingArea
v
ScrolledWindow -> PolicyType -> PolicyType -> IO ()
forall self.
ScrolledWindowClass self =>
self -> PolicyType -> PolicyType -> IO ()
scrolledWindowSetPolicy ScrolledWindow
sw PolicyType
PolicyAutomatic PolicyType
PolicyNever
Box
box <- if Window -> Bool
isMini Window
w
then do
Label
prompt <- Maybe Text -> IO Label
forall string. GlibString string => Maybe string -> IO Label
labelNew (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FBuffer -> Text
miniIdentString FBuffer
b)
Label -> Maybe FontDescription -> IO ()
forall self.
WidgetClass self =>
self -> Maybe FontDescription -> IO ()
widgetModifyFont Label
prompt (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
f)
HBox
hb <- Bool -> TabRef -> IO HBox
hBoxNew Bool
False 1
HBox -> [AttrOp HBox] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set HBox
hb [ WriteAttr HBox Label
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr HBox Label -> Label -> AttrOp HBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Label
prompt,
WriteAttr HBox ScrolledWindow
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr HBox ScrolledWindow -> ScrolledWindow -> AttrOp HBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= ScrolledWindow
sw,
Label -> Attr HBox Packing
forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking Label
prompt Attr HBox Packing -> Packing -> AttrOp HBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Packing
PackNatural,
ScrolledWindow -> Attr HBox Packing
forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking ScrolledWindow
sw Attr HBox Packing -> Packing -> AttrOp HBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Packing
PackGrow]
Box -> IO Box
forall (m :: * -> *) a. Monad m => a -> m a
return (HBox -> Box
forall obj. GObjectClass obj => obj -> Box
castToBox HBox
hb)
else do
VBox
vb <- Bool -> TabRef -> IO VBox
vBoxNew Bool
False 1
VBox -> [AttrOp VBox] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set VBox
vb [ WriteAttr VBox ScrolledWindow
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr VBox ScrolledWindow -> ScrolledWindow -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= ScrolledWindow
sw,
WriteAttr VBox Label
forall self widget.
(ContainerClass self, WidgetClass widget) =>
WriteAttr self widget
containerChild WriteAttr VBox Label -> Label -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Label
ml,
Label -> Attr VBox Packing
forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking Label
ml Attr VBox Packing -> Packing -> AttrOp VBox
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= Packing
PackNatural]
Box -> IO Box
forall (m :: * -> *) a. Monad m => a -> m a
return (VBox -> Box
forall obj. GObjectClass obj => obj -> Box
castToBox VBox
vb)
IORef Point
tosRef <- Point -> IO (IORef Point)
forall a. a -> IO (IORef a)
newIORef (Window -> FBuffer -> BufferM Point -> Point
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
w FBuffer
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))
PangoContext
context <- DrawingArea -> IO PangoContext
forall self. WidgetClass self => self -> IO PangoContext
widgetCreatePangoContext DrawingArea
v
PangoLayout
layout <- PangoContext -> IO PangoLayout
layoutEmpty PangoContext
context
MVar WinLayoutInfo
layoutRef <- WinLayoutInfo -> IO (MVar WinLayoutInfo)
forall a. a -> IO (MVar a)
newMVar (PangoLayout
-> Point
-> Point
-> Point
-> Point
-> FBuffer
-> Maybe SearchExp
-> WinLayoutInfo
WinLayoutInfo PangoLayout
layout 0 0 0 0
(BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
w) Editor
e) Maybe SearchExp
forall a. Maybe a
Nothing)
Language
language <- PangoContext -> IO Language
contextGetLanguage PangoContext
context
FontMetrics
metrics <- PangoContext -> FontDescription -> Language -> IO FontMetrics
contextGetMetrics PangoContext
context FontDescription
f Language
language
IORef Bool
ifLButton <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef Bool
imode <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef Bool
focused <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef Window
winRef <- Window -> IO (IORef Window)
forall a. a -> IO (IORef a)
newIORef Window
w
PangoLayout -> Maybe FontDescription -> IO ()
layoutSetFontDescription PangoLayout
layout (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
f)
PangoLayout -> Text -> IO ()
forall string. GlibString string => PangoLayout -> string -> IO ()
layoutSetText PangoLayout
layout Text
T.empty
let ref :: WindowRef
ref = Window -> WindowRef
wkey Window
w
win :: WinInfo
win = WinInfo :: WindowRef
-> IORef Window
-> IORef Point
-> IORef Bool
-> IORef Bool
-> IORef Bool
-> MVar WinLayoutInfo
-> FontMetrics
-> DrawingArea
-> Label
-> Widget
-> WinInfo
WinInfo { coreWinKey :: WindowRef
coreWinKey = WindowRef
ref
, coreWin :: IORef Window
coreWin = IORef Window
winRef
, winLayoutInfo :: MVar WinLayoutInfo
winLayoutInfo = MVar WinLayoutInfo
layoutRef
, winMetrics :: FontMetrics
winMetrics = FontMetrics
metrics
, textview :: DrawingArea
textview = DrawingArea
v
, modeline :: Label
modeline = Label
ml
, winWidget :: Widget
winWidget = Box -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Box
box
, shownTos :: IORef Point
shownTos = IORef Point
tosRef
, lButtonPressed :: IORef Bool
lButtonPressed = IORef Bool
ifLButton
, insertingMode :: IORef Bool
insertingMode = IORef Bool
imode
, inFocus :: IORef Bool
inFocus = IORef Bool
focused
}
Editor -> UI -> Window -> WinInfo -> IO ()
updateWindow Editor
e UI
ui Window
w WinInfo
win
DrawingArea
v DrawingArea
-> Signal DrawingArea (EventM EButton Bool)
-> EventM EButton Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal DrawingArea (EventM EButton Bool)
forall self. WidgetClass self => Signal self (EventM EButton Bool)
buttonPressEvent (EventM EButton Bool -> IO ()) -> EventM EButton Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> WindowRef -> EventM EButton Bool
handleButtonClick UI
ui WindowRef
ref
DrawingArea
v DrawingArea
-> Signal DrawingArea (EventM EButton Bool)
-> EventM EButton Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal DrawingArea (EventM EButton Bool)
forall self. WidgetClass self => Signal self (EventM EButton Bool)
buttonReleaseEvent (EventM EButton Bool -> IO ()) -> EventM EButton Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> WinInfo -> EventM EButton Bool
handleButtonRelease UI
ui WinInfo
win
DrawingArea
v DrawingArea
-> Signal DrawingArea (EventM EScroll Bool)
-> EventM EScroll Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal DrawingArea (EventM EScroll Bool)
forall self. WidgetClass self => Signal self (EventM EScroll Bool)
scrollEvent (EventM EScroll Bool -> IO ()) -> EventM EScroll Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> WinInfo -> EventM EScroll Bool
handleScroll UI
ui WinInfo
win
DrawingArea
v DrawingArea
-> Signal DrawingArea (EventM EConfigure Bool)
-> EventM EConfigure Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal DrawingArea (EventM EConfigure Bool)
forall self.
WidgetClass self =>
Signal self (EventM EConfigure Bool)
configureEvent (EventM EConfigure Bool -> IO ())
-> EventM EConfigure Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> EventM EConfigure Bool
handleConfigure UI
ui
DrawingArea
v DrawingArea
-> Signal DrawingArea (EventM EMotion Bool)
-> EventM EMotion Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal DrawingArea (EventM EMotion Bool)
forall self. WidgetClass self => Signal self (EventM EMotion Bool)
motionNotifyEvent (EventM EMotion Bool -> IO ()) -> EventM EMotion Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> WinInfo -> EventM EMotion Bool
handleMove UI
ui WinInfo
win
IO (ConnectId DrawingArea) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ConnectId DrawingArea) -> IO ())
-> IO (ConnectId DrawingArea) -> IO ()
forall a b. (a -> b) -> a -> b
$ DrawingArea
v DrawingArea -> (Event -> IO Bool) -> IO (ConnectId DrawingArea)
forall w.
WidgetClass w =>
w -> (Event -> IO Bool) -> IO (ConnectId w)
`onExpose` UI -> WinInfo -> Event -> IO Bool
forall t. UI -> WinInfo -> t -> IO Bool
render UI
ui WinInfo
win
UI -> Window
uiWindow UI
ui Window
-> Signal Window (EventM EFocus Bool)
-> EventM EFocus Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal Window (EventM EFocus Bool)
forall self. WidgetClass self => Signal self (EventM EFocus Bool)
focusInEvent (EventM EFocus Bool -> IO ()) -> EventM EFocus Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT (Ptr EFocus) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw DrawingArea
v) ReaderT (Ptr EFocus) IO ()
-> EventM EFocus Bool -> EventM EFocus Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> EventM EFocus Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
UI -> Window
uiWindow UI
ui Window
-> Signal Window (EventM EFocus Bool)
-> EventM EFocus Bool
-> IO ()
forall object callback.
object -> Signal object callback -> callback -> IO ()
`on` Signal Window (EventM EFocus Bool)
forall self. WidgetClass self => Signal self (EventM EFocus Bool)
focusOutEvent (EventM EFocus Bool -> IO ()) -> EventM EFocus Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT (Ptr EFocus) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw DrawingArea
v) ReaderT (Ptr EFocus) IO ()
-> EventM EFocus Bool -> EventM EFocus Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> EventM EFocus Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
WinInfo -> IO WinInfo
forall (m :: * -> *) a. Monad m => a -> m a
return WinInfo
win
refresh :: UI -> Editor -> IO ()
refresh :: UI -> Editor -> IO ()
refresh ui :: UI
ui e :: Editor
e = do
IO () -> IO ()
postGUIAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
GErrorDomain
contextId <- Statusbar -> Text -> IO GErrorDomain
forall self string.
(StatusbarClass self, GlibString string) =>
self -> string -> IO GErrorDomain
statusbarGetContextId (UI -> Statusbar
uiStatusbar UI
ui) ("global" :: T.Text)
Statusbar -> GErrorDomain -> IO ()
forall self. StatusbarClass self => self -> GErrorDomain -> IO ()
statusbarPop (UI -> Statusbar
uiStatusbar UI
ui) GErrorDomain
contextId
IO MessageId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO MessageId -> IO ()) -> IO MessageId -> IO ()
forall a b. (a -> b) -> a -> b
$ Statusbar -> GErrorDomain -> Text -> IO MessageId
forall self string.
(StatusbarClass self, GlibString string) =>
self -> GErrorDomain -> string -> IO MessageId
statusbarPush (UI -> Statusbar
uiStatusbar UI
ui) GErrorDomain
contextId (Text -> IO MessageId) -> Text -> IO MessageId
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
Editor -> [Text]
statusLine Editor
e
UI -> Editor -> IO ()
updateCache UI
ui Editor
e
TabCache
cache <- IORef TabCache -> IO TabCache
forall a. IORef a -> IO a
readIORef (IORef TabCache -> IO TabCache) -> IORef TabCache -> IO TabCache
forall a b. (a -> b) -> a -> b
$ UI -> IORef TabCache
tabCache UI
ui
TabCache -> (TabInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ TabCache
cache ((TabInfo -> IO ()) -> IO ()) -> (TabInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \t :: TabInfo
t -> do
WindowCache
wCache <- IORef WindowCache -> IO WindowCache
forall a. IORef a -> IO a
readIORef (TabInfo -> IORef WindowCache
windowCache TabInfo
t)
WindowCache -> (WinInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ WindowCache
wCache ((WinInfo -> IO ()) -> IO ()) -> (WinInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \w :: WinInfo
w -> do
Editor -> UI -> WinInfo -> IO ()
updateWinInfoForRendering Editor
e UI
ui WinInfo
w
DrawingArea -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetQueueDraw (WinInfo -> DrawingArea
textview WinInfo
w)
updateWinInfoForRendering :: Editor -> UI -> WinInfo -> IO ()
updateWinInfoForRendering :: Editor -> UI -> WinInfo -> IO ()
updateWinInfoForRendering e :: Editor
e _ui :: UI
_ui w :: WinInfo
w = MVar WinLayoutInfo -> (WinLayoutInfo -> IO WinLayoutInfo) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (WinInfo -> MVar WinLayoutInfo
winLayoutInfo WinInfo
w) ((WinLayoutInfo -> IO WinLayoutInfo) -> IO ())
-> (WinLayoutInfo -> IO WinLayoutInfo) -> IO ()
forall a b. (a -> b) -> a -> b
$ \wli :: WinLayoutInfo
wli -> do
Window
win <- IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
w)
WinLayoutInfo -> IO WinLayoutInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (WinLayoutInfo -> IO WinLayoutInfo)
-> WinLayoutInfo -> IO WinLayoutInfo
forall a b. (a -> b) -> a -> b
$! WinLayoutInfo
wli{buffer :: FBuffer
buffer=BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e,regex :: Maybe SearchExp
regex=Editor -> Maybe SearchExp
currentRegex Editor
e}
render :: UI -> WinInfo -> t -> IO Bool
render :: UI -> WinInfo -> t -> IO Bool
render ui :: UI
ui w :: WinInfo
w _event :: t
_event =
MVar WinLayoutInfo -> (WinLayoutInfo -> IO Bool) -> IO Bool
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (WinInfo -> MVar WinLayoutInfo
winLayoutInfo WinInfo
w) ((WinLayoutInfo -> IO Bool) -> IO Bool)
-> (WinLayoutInfo -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
\WinLayoutInfo{winLayout :: WinLayoutInfo -> PangoLayout
winLayout=PangoLayout
layout,Point
tos :: Point
tos :: WinLayoutInfo -> Point
tos,Point
bos :: Point
bos :: WinLayoutInfo -> Point
bos,Point
cur :: Point
cur :: WinLayoutInfo -> Point
cur,buffer :: WinLayoutInfo -> FBuffer
buffer=FBuffer
b,Maybe SearchExp
regex :: Maybe SearchExp
regex :: WinLayoutInfo -> Maybe SearchExp
regex} -> do
Window
win <- IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
w)
let picture :: [(Point, Attributes)]
picture = Window
-> FBuffer
-> BufferM [(Point, Attributes)]
-> [(Point, Attributes)]
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
win FBuffer
b (BufferM [(Point, Attributes)] -> [(Point, Attributes)])
-> BufferM [(Point, Attributes)] -> [(Point, Attributes)]
forall a b. (a -> b) -> a -> b
$ UIStyle
-> Maybe SearchExp -> Region -> BufferM [(Point, Attributes)]
attributesPictureAndSelB UIStyle
sty Maybe SearchExp
regex
(Point -> Point -> Region
mkRegion Point
tos Point
bos)
sty :: UIStyle
sty = UIConfig -> UIStyle
configStyle (UIConfig -> UIStyle) -> UIConfig -> UIStyle
forall a b. (a -> b) -> a -> b
$ UI -> UIConfig
uiConfig UI
ui
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
$ TabRef -> [Point] -> [Point]
forall a. TabRef -> [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 [ (TabRef -> TabRef -> Color -> PangoAttribute)
-> Color -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr TabRef -> TabRef -> Color -> PangoAttribute
AttrForeground (Color -> PangoAttribute) -> Color -> PangoAttribute
forall a b. (a -> b) -> a -> b
$ Bool -> Color -> Color
mkCol Bool
True Color
fg
, (TabRef -> TabRef -> Color -> PangoAttribute)
-> Color -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr TabRef -> TabRef -> Color -> PangoAttribute
AttrBackground (Color -> PangoAttribute) -> Color -> PangoAttribute
forall a b. (a -> b) -> a -> b
$ Bool -> Color -> Color
mkCol Bool
False Color
bg
, (TabRef -> TabRef -> FontStyle -> PangoAttribute)
-> FontStyle -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr TabRef -> TabRef -> 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
, (TabRef -> TabRef -> Underline -> PangoAttribute)
-> Underline -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr TabRef -> TabRef -> 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
, (TabRef -> TabRef -> Weight -> PangoAttribute)
-> Weight -> PangoAttribute
forall t t t. (Num t, Num t) => (t -> t -> t) -> t
atr TabRef -> TabRef -> 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
]
PangoLayout -> [PangoAttribute] -> IO ()
layoutSetAttributes PangoLayout
layout [PangoAttribute]
allAttrs
DrawWindow
drawWindow <- DrawingArea -> IO DrawWindow
forall widget. WidgetClass widget => widget -> IO DrawWindow
widgetGetDrawWindow (DrawingArea -> IO DrawWindow) -> DrawingArea -> IO DrawWindow
forall a b. (a -> b) -> a -> b
$ WinInfo -> DrawingArea
textview WinInfo
w
GC
gc <- DrawWindow -> IO GC
forall d. DrawableClass d => d -> IO GC
gcNew DrawWindow
drawWindow
DrawWindow -> GC -> TabRef -> TabRef -> PangoLayout -> IO ()
forall d.
DrawableClass d =>
d -> GC -> TabRef -> TabRef -> PangoLayout -> IO ()
drawLayout DrawWindow
drawWindow GC
gc 1 0 PangoLayout
layout
Bool
im <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Bool
insertingMode WinInfo
w)
Bool
bufferFocused <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Bool
inFocus WinInfo
w)
Bool
uiFocused <- Window -> IO Bool
forall self. WindowClass self => self -> IO Bool
Gtk.windowHasToplevelFocus (UI -> Window
uiWindow UI
ui)
let focused :: Bool
focused = Bool
bufferFocused Bool -> Bool -> Bool
&& Bool
uiFocused
wideCursor :: Bool
wideCursor =
case UIConfig -> CursorStyle
configCursorStyle (UI -> UIConfig
uiConfig UI
ui) of
AlwaysFat -> Bool
True
NeverFat -> Bool
False
FatWhenFocused -> Bool
focused
FatWhenFocusedAndInserting -> Bool
focused Bool -> Bool -> Bool
&& Bool
im
(PangoRectangle (DividerPosition -> DividerPosition
forall a. Enum a => a -> a
succ -> DividerPosition
curX) curY :: DividerPosition
curY curW :: DividerPosition
curW curH :: DividerPosition
curH, _) <-
PangoLayout -> TabRef -> IO (PangoRectangle, PangoRectangle)
layoutGetCursorPos PangoLayout
layout (Point -> TabRef
forall b. Num b => Point -> b
rel Point
cur)
IMContext -> Rectangle -> IO ()
forall self. IMContextClass self => self -> Rectangle -> IO ()
imContextSetCursorLocation (UI -> IMContext
uiInput UI
ui) (Rectangle -> IO ()) -> Rectangle -> IO ()
forall a b. (a -> b) -> a -> b
$
TabRef -> TabRef -> TabRef -> TabRef -> Rectangle
Rectangle (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
curX) (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
curY) (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
curW) (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
curH)
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
$
UI -> UIConfig
uiConfig UI
ui
, lineWidth :: TabRef
Gtk.lineWidth = if Bool
wideCursor then 2 else 1 })
if Bool
im
then
DrawWindow -> GC -> Point -> Point -> IO ()
forall d. DrawableClass d => d -> GC -> Point -> Point -> IO ()
drawLine DrawWindow
drawWindow GC
gc (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
curX, DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
curY)
(DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round (DividerPosition -> TabRef) -> DividerPosition -> TabRef
forall a b. (a -> b) -> a -> b
$ DividerPosition
curX DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
+ DividerPosition
curW, DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round (DividerPosition -> TabRef) -> DividerPosition -> TabRef
forall a b. (a -> b) -> a -> b
$ DividerPosition
curY DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
+ DividerPosition
curH)
else do
PangoRectangle (DividerPosition -> DividerPosition
forall a. Enum a => a -> a
succ -> DividerPosition
chx) chy :: DividerPosition
chy chw :: DividerPosition
chw chh :: DividerPosition
chh <- PangoLayout -> TabRef -> IO PangoRectangle
layoutIndexToPos
PangoLayout
layout (Point -> TabRef
forall b. Num b => Point -> b
rel Point
cur)
DrawWindow
-> GC -> Bool -> TabRef -> TabRef -> TabRef -> TabRef -> IO ()
forall d.
DrawableClass d =>
d -> GC -> Bool -> TabRef -> TabRef -> TabRef -> TabRef -> IO ()
drawRectangle DrawWindow
drawWindow GC
gc Bool
False (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
chx) (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
chy)
(if DividerPosition
chw DividerPosition -> DividerPosition -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
chw else 8) (DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round DividerPosition
chh)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
doLayout :: UI -> Editor -> IO Editor
doLayout :: UI -> Editor -> IO Editor
doLayout ui :: UI
ui e :: Editor
e = do
UI -> Editor -> IO ()
updateCache UI
ui Editor
e
TabCache
tabs <- IORef TabCache -> IO TabCache
forall a. IORef a -> IO a
readIORef (IORef TabCache -> IO TabCache) -> IORef TabCache -> IO TabCache
forall a b. (a -> b) -> a -> b
$ UI -> IORef TabCache
tabCache UI
ui
FontDescription
f <- IORef FontDescription -> IO FontDescription
forall a. IORef a -> IO a
readIORef (UI -> IORef FontDescription
uiFont UI
ui)
Map WindowRef (TabRef, TabRef, Region)
dims <- PointedList (Map WindowRef (TabRef, TabRef, Region))
-> Map WindowRef (TabRef, TabRef, Region)
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (PointedList (Map WindowRef (TabRef, TabRef, Region))
-> Map WindowRef (TabRef, TabRef, Region))
-> IO (PointedList (Map WindowRef (TabRef, TabRef, Region)))
-> IO (Map WindowRef (TabRef, TabRef, Region))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TabInfo -> IO (Map WindowRef (TabRef, TabRef, Region)))
-> TabCache
-> IO (PointedList (Map WindowRef (TabRef, TabRef, Region)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (UI
-> FontDescription
-> Editor
-> TabInfo
-> IO (Map WindowRef (TabRef, TabRef, Region))
getDimensionsInTab UI
ui FontDescription
f Editor
e) TabCache
tabs
let e' :: Editor
e' = (ASetter Editor Editor (PointedList Tab) (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA ASetter Editor Editor (PointedList Tab) (PointedList Tab)
-> (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
-> Map WindowRef (TabRef, TabRef, Region)
-> Maybe (TabRef, TabRef, Region)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Window -> WindowRef
wkey Window
w) Map WindowRef (TabRef, TabRef, Region)
dims of
Nothing -> Window
w
Just (wi :: TabRef
wi,h :: TabRef
h,rgn :: Region
rgn) -> Window
w { width :: TabRef
width = TabRef
wi, height :: TabRef
height = TabRef
h, winRegion :: Region
winRegion = Region
rgn }
let forceWin :: p -> Window -> p
forceWin x :: p
x w :: Window
w = Window -> TabRef
height Window
w TabRef -> 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 -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> IO Editor) -> Editor -> IO 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)
getDimensionsInTab :: UI -> FontDescription -> Editor
-> TabInfo -> IO (M.Map WindowRef (Int,Int,Region))
getDimensionsInTab :: UI
-> FontDescription
-> Editor
-> TabInfo
-> IO (Map WindowRef (TabRef, TabRef, Region))
getDimensionsInTab ui :: UI
ui f :: FontDescription
f e :: Editor
e tab :: TabInfo
tab = do
WindowCache
wCache <- IORef WindowCache -> IO WindowCache
forall a. IORef a -> IO a
readIORef (TabInfo -> IORef WindowCache
windowCache TabInfo
tab)
WindowCache
-> (WinInfo -> IO (TabRef, TabRef, Region))
-> IO (Map WindowRef (TabRef, TabRef, Region))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM WindowCache
wCache ((WinInfo -> IO (TabRef, TabRef, Region))
-> IO (Map WindowRef (TabRef, TabRef, Region)))
-> (WinInfo -> IO (TabRef, TabRef, Region))
-> IO (Map WindowRef (TabRef, TabRef, Region))
forall a b. (a -> b) -> a -> b
$ \wi :: WinInfo
wi -> do
(wid :: TabRef
wid, h :: TabRef
h) <- DrawingArea -> IO Point
forall widget. WidgetClass widget => widget -> IO Point
widgetGetSize (DrawingArea -> IO Point) -> DrawingArea -> IO Point
forall a b. (a -> b) -> a -> b
$ WinInfo -> DrawingArea
textview WinInfo
wi
Window
win <- IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
wi)
let metrics :: FontMetrics
metrics = WinInfo -> FontMetrics
winMetrics WinInfo
wi
lineHeight :: DividerPosition
lineHeight = FontMetrics -> DividerPosition
ascent FontMetrics
metrics DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
+ FontMetrics -> DividerPosition
descent FontMetrics
metrics
charWidth :: DividerPosition
charWidth = DividerPosition -> DividerPosition -> DividerPosition
forall a. Ord a => a -> a -> a
max (FontMetrics -> DividerPosition
approximateCharWidth FontMetrics
metrics) (FontMetrics -> DividerPosition
approximateDigitWidth FontMetrics
metrics)
width :: TabRef
width = DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round (DividerPosition -> TabRef) -> DividerPosition -> TabRef
forall a b. (a -> b) -> a -> b
$ TabRef -> DividerPosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral TabRef
wid DividerPosition -> DividerPosition -> DividerPosition
forall a. Fractional a => a -> a -> a
/ DividerPosition
charWidth DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
- 1
height :: TabRef
height = DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
round (DividerPosition -> TabRef) -> DividerPosition -> TabRef
forall a b. (a -> b) -> a -> b
$ TabRef -> DividerPosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral TabRef
h DividerPosition -> DividerPosition -> DividerPosition
forall a. Fractional a => a -> a -> a
/ DividerPosition
lineHeight
b0 :: FBuffer
b0 = BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e
Region
rgn <- UI -> FontDescription -> WinInfo -> FBuffer -> IO Region
shownRegion UI
ui FontDescription
f WinInfo
wi FBuffer
b0
(TabRef, TabRef, Region) -> IO (TabRef, TabRef, Region)
forall (m :: * -> *) a. Monad m => a -> m a
return (TabRef
width, TabRef
height, Region
rgn)
shownRegion :: UI -> FontDescription -> WinInfo -> FBuffer -> IO Region
shownRegion :: UI -> FontDescription -> WinInfo -> FBuffer -> IO Region
shownRegion ui :: UI
ui f :: FontDescription
f w :: WinInfo
w b :: FBuffer
b = MVar WinLayoutInfo
-> (WinLayoutInfo -> IO (WinLayoutInfo, Region)) -> IO Region
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (WinInfo -> MVar WinLayoutInfo
winLayoutInfo WinInfo
w) ((WinLayoutInfo -> IO (WinLayoutInfo, Region)) -> IO Region)
-> (WinLayoutInfo -> IO (WinLayoutInfo, Region)) -> IO Region
forall a b. (a -> b) -> a -> b
$ \wli :: WinLayoutInfo
wli -> do
(tos :: Point
tos, cur :: Point
cur, bos :: Point
bos, bufEnd :: Point
bufEnd) <- UI
-> FontDescription
-> WinInfo
-> FBuffer
-> PangoLayout
-> IO (Point, Point, Point, Point)
updatePango UI
ui FontDescription
f WinInfo
w FBuffer
b (WinLayoutInfo -> PangoLayout
winLayout WinLayoutInfo
wli)
(WinLayoutInfo, Region) -> IO (WinLayoutInfo, Region)
forall (m :: * -> *) a. Monad m => a -> m a
return (WinLayoutInfo
wli{Point
tos :: Point
tos :: Point
tos,cur :: Point
cur=Point -> Point -> Point -> Point
forall a. Ord a => a -> a -> a -> a
clampTo Point
tos Point
bos Point
cur,Point
bos :: Point
bos :: Point
bos,Point
bufEnd :: Point
bufEnd :: Point
bufEnd}, Point -> Point -> Region
mkRegion Point
tos Point
bos)
where clampTo :: a -> a -> a -> a
clampTo lo :: a
lo hi :: a
hi x :: a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max a
lo (a -> a -> a
forall a. Ord a => a -> a -> a
min a
hi a
x)
updatePango :: UI -> FontDescription -> WinInfo -> FBuffer
-> PangoLayout -> IO (Point, Point, Point, Point)
updatePango :: UI
-> FontDescription
-> WinInfo
-> FBuffer
-> PangoLayout
-> IO (Point, Point, Point, Point)
updatePango ui :: UI
ui font :: FontDescription
font w :: WinInfo
w b :: FBuffer
b layout :: PangoLayout
layout = do
(width_' :: TabRef
width_', height' :: TabRef
height') <- DrawingArea -> IO Point
forall widget. WidgetClass widget => widget -> IO Point
widgetGetSize (DrawingArea -> IO Point) -> DrawingArea -> IO Point
forall a b. (a -> b) -> a -> b
$ WinInfo -> DrawingArea
textview WinInfo
w
let width' :: TabRef
width' = TabRef -> TabRef -> TabRef
forall a. Ord a => a -> a -> a
max 0 (TabRef
width_' TabRef -> TabRef -> TabRef
forall a. Num a => a -> a -> a
- 1)
fontDescriptionToStringT :: FontDescription -> IO Text
fontDescriptionToStringT :: FontDescription -> IO Text
fontDescriptionToStringT = FontDescription -> IO Text
forall string. GlibString string => FontDescription -> IO string
fontDescriptionToString
FontDescription
curFont <- case TabRef -> DividerPosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TabRef -> DividerPosition)
-> Maybe TabRef -> Maybe DividerPosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIConfig -> Maybe TabRef
configFontSize (UI -> UIConfig
uiConfig UI
ui) of
Nothing -> FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
font
Just defSize :: DividerPosition
defSize -> FontDescription -> IO (Maybe DividerPosition)
fontDescriptionGetSize FontDescription
font IO (Maybe DividerPosition)
-> (Maybe DividerPosition -> IO FontDescription)
-> IO FontDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> FontDescription -> DividerPosition -> IO ()
fontDescriptionSetSize FontDescription
font DividerPosition
defSize IO () -> IO FontDescription -> IO FontDescription
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
font
Just currentSize :: DividerPosition
currentSize -> let fsv :: TabRef
fsv = Attributes -> TabRef
fontsizeVariation (Attributes -> TabRef) -> Attributes -> TabRef
forall a b. (a -> b) -> a -> b
$ FBuffer -> Attributes
attributes FBuffer
b
newSize :: DividerPosition
newSize = DividerPosition -> DividerPosition -> DividerPosition
forall a. Ord a => a -> a -> a
max 1 (TabRef -> DividerPosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral TabRef
fsv DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
+ DividerPosition
defSize) in
if DividerPosition
newSize DividerPosition -> DividerPosition -> Bool
forall a. Eq a => a -> a -> Bool
== DividerPosition
currentSize
then FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
font
else do
FontDescription
nf <- FontDescription -> IO FontDescription
fontDescriptionCopy FontDescription
font
FontDescription -> DividerPosition -> IO ()
fontDescriptionSetSize FontDescription
nf DividerPosition
newSize
FontDescription -> IO FontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return FontDescription
nf
Maybe FontDescription
oldFont <- PangoLayout -> IO (Maybe FontDescription)
layoutGetFontDescription PangoLayout
layout
Maybe Text
oldFontStr <- IO (Maybe Text)
-> (FontDescription -> IO (Maybe Text))
-> Maybe FontDescription
-> IO (Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing)
((Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (IO Text -> IO (Maybe Text))
-> (FontDescription -> IO Text)
-> FontDescription
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontDescription -> IO Text
fontDescriptionToStringT) Maybe FontDescription
oldFont
Maybe Text
newFontStr <- Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontDescription -> IO Text
fontDescriptionToStringT FontDescription
curFont
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text
oldFontStr Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Text
newFontStr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
PangoLayout -> Maybe FontDescription -> IO ()
layoutSetFontDescription PangoLayout
layout (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
curFont)
Window
win <- IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
w)
let [width'' :: DividerPosition
width'', height'' :: DividerPosition
height''] = (TabRef -> DividerPosition) -> [TabRef] -> [DividerPosition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TabRef -> DividerPosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral [TabRef
width', TabRef
height']
metrics :: FontMetrics
metrics = WinInfo -> FontMetrics
winMetrics WinInfo
w
lineHeight :: DividerPosition
lineHeight = FontMetrics -> DividerPosition
ascent FontMetrics
metrics DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
+ FontMetrics -> DividerPosition
descent FontMetrics
metrics
charWidth :: DividerPosition
charWidth = DividerPosition -> DividerPosition -> DividerPosition
forall a. Ord a => a -> a -> a
max (FontMetrics -> DividerPosition
approximateCharWidth FontMetrics
metrics)
(FontMetrics -> DividerPosition
approximateDigitWidth FontMetrics
metrics)
winw :: TabRef
winw = TabRef -> TabRef -> TabRef
forall a. Ord a => a -> a -> a
max 1 (TabRef -> TabRef) -> TabRef -> TabRef
forall a b. (a -> b) -> a -> b
$ DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
floor (DividerPosition
width'' DividerPosition -> DividerPosition -> DividerPosition
forall a. Fractional a => a -> a -> a
/ DividerPosition
charWidth)
winh :: TabRef
winh = TabRef -> TabRef -> TabRef
forall a. Ord a => a -> a -> a
max 1 (TabRef -> TabRef) -> TabRef -> TabRef
forall a b. (a -> b) -> a -> b
$ DividerPosition -> TabRef
forall a b. (RealFrac a, Integral b) => a -> b
floor (DividerPosition
height'' DividerPosition -> DividerPosition -> DividerPosition
forall a. Fractional a => a -> a -> a
/ DividerPosition
lineHeight)
maxChars :: TabRef
maxChars = TabRef
winw TabRef -> TabRef -> TabRef
forall a. Num a => a -> a -> a
* TabRef
winh
conf :: UIConfig
conf = UI -> UIConfig
uiConfig UI
ui
(tos :: Point
tos, size :: Point
size, point :: Point
point, text :: Text
text) = Window
-> FBuffer
-> BufferM (Point, Point, Point, Text)
-> (Point, Point, Point, Text)
forall a. Window -> FBuffer -> BufferM a -> a
askBuffer Window
win FBuffer
b (BufferM (Point, Point, Point, Text)
-> (Point, Point, Point, Text))
-> BufferM (Point, Point, Point, Text)
-> (Point, Point, Point, Text)
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
Point
bufEnd <- BufferM Point
sizeB
let content :: YiString
content = UIConfig -> TabRef -> YiString -> YiString
takeContent UIConfig
conf TabRef
maxChars (YiString -> YiString)
-> ((YiString, YiString) -> YiString)
-> (YiString, YiString)
-> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString, YiString) -> YiString
forall a b. (a -> b) -> a -> b
$ TabRef -> YiString -> (YiString, YiString)
R.splitAtLine TabRef
winh YiString
rope
let addNL :: YiString -> YiString
addNL = if YiString -> TabRef
R.countNewLines YiString
content TabRef -> TabRef -> Bool
forall a. Eq a => a -> a -> Bool
== TabRef
winh
then YiString -> YiString
forall a. a -> a
id
else (YiString -> Char -> YiString
`R.snoc` '\n')
(Point, Point, Point, Text) -> BufferM (Point, Point, Point, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
from, Point
bufEnd, Point
p, YiString -> Text
R.toText (YiString -> Text) -> YiString -> Text
forall a b. (a -> b) -> a -> b
$ YiString -> YiString
addNL YiString
content)
if UIConfig -> Bool
configLineWrap UIConfig
conf
then PangoLayout -> LayoutWrapMode -> DividerPosition -> IO ()
wrapToWidth PangoLayout
layout LayoutWrapMode
WrapAnywhere DividerPosition
width''
else do
(Rectangle px :: TabRef
px _py :: TabRef
_py pwidth :: TabRef
pwidth _pheight :: TabRef
_pheight, _) <- PangoLayout -> IO (Rectangle, Rectangle)
layoutGetPixelExtents PangoLayout
layout
DrawingArea -> TabRef -> TabRef -> IO ()
forall self. WidgetClass self => self -> TabRef -> TabRef -> IO ()
widgetSetSizeRequest (WinInfo -> DrawingArea
textview WinInfo
w) (TabRef
pxTabRef -> TabRef -> TabRef
forall a. Num a => a -> a -> a
+TabRef
pwidth) (-1)
Text
oldText <- PangoLayout -> IO Text
forall string. GlibString string => PangoLayout -> IO string
layoutGetText PangoLayout
layout
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
oldText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
text) (PangoLayout -> Text -> IO ()
forall string. GlibString string => PangoLayout -> string -> IO ()
layoutSetText PangoLayout
layout Text
text)
(_, bosOffset :: TabRef
bosOffset, _) <- PangoLayout
-> DividerPosition -> DividerPosition -> IO (Bool, TabRef, TabRef)
layoutXYToIndex PangoLayout
layout DividerPosition
width''
(TabRef -> DividerPosition
forall a b. (Integral a, Num b) => a -> b
fromIntegral TabRef
winh DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
* DividerPosition
lineHeight DividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
- 1)
(Point, Point, Point, Point) -> IO (Point, 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
+ TabRef -> Point
forall a b. (Integral a, Num b) => a -> b
fromIntegral TabRef
bosOffset Point -> Point -> Point
forall a. Num a => a -> a -> a
+ 1, Point
size)
takeContent :: UIConfig -> Int -> R.YiString -> R.YiString
takeContent :: UIConfig -> TabRef -> YiString -> YiString
takeContent cf :: UIConfig
cf cl :: TabRef
cl t :: YiString
t = if UIConfig -> Bool
configLineWrap UIConfig
cf
then TabRef -> YiString -> YiString
R.take TabRef
cl YiString
t
else YiString
t
wrapToWidth :: PangoLayout -> LayoutWrapMode -> Double -> IO ()
wrapToWidth :: PangoLayout -> LayoutWrapMode -> DividerPosition -> IO ()
wrapToWidth l :: PangoLayout
l wm :: LayoutWrapMode
wm w :: DividerPosition
w = do
PangoLayout -> IO LayoutWrapMode
layoutGetWrap PangoLayout
l IO LayoutWrapMode -> (LayoutWrapMode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \wr :: LayoutWrapMode
wr -> case (LayoutWrapMode
wr, LayoutWrapMode
wm) of
(WrapWholeWords, WrapWholeWords) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(WrapAnywhere, WrapAnywhere) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(WrapPartialWords, WrapPartialWords) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> PangoLayout -> LayoutWrapMode -> IO ()
layoutSetWrap PangoLayout
l LayoutWrapMode
wm
PangoLayout -> IO (Maybe DividerPosition)
layoutGetWidth PangoLayout
l IO (Maybe DividerPosition)
-> (Maybe DividerPosition -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just x :: DividerPosition
x | DividerPosition
x DividerPosition -> DividerPosition -> Bool
forall a. Eq a => a -> a -> Bool
== DividerPosition
w -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> PangoLayout -> Maybe DividerPosition -> IO ()
layoutSetWidth PangoLayout
l (DividerPosition -> Maybe DividerPosition
forall a. a -> Maybe a
Just DividerPosition
w)
reloadProject :: IO ()
reloadProject :: IO ()
reloadProject = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mkCol :: Bool
-> 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)
handleKeypress :: ([Event] -> IO ())
-> IMContext
-> EventM EKey Bool
handleKeypress :: ([Event] -> IO ()) -> IMContext -> EventM EKey Bool
handleKeypress ch :: [Event] -> IO ()
ch im :: IMContext
im = do
[Modifier]
gtkMods <- EventM EKey [Modifier]
forall t. HasModifier t => EventM t [Modifier]
eventModifier
KeyVal
gtkKey <- EventM EKey KeyVal
eventKeyVal
Bool
ifIM <- IMContext -> EventM EKey Bool
forall self. IMContextClass self => self -> EventM EKey Bool
imContextFilterKeypress IMContext
im
let char :: Maybe Char
char = KeyVal -> Maybe Char
keyToChar KeyVal
gtkKey
modsWithShift :: [Modifier]
modsWithShift = Map Modifier Modifier -> [Modifier]
forall k a. Map k a -> [k]
M.keys (Map Modifier Modifier -> [Modifier])
-> Map Modifier Modifier -> [Modifier]
forall a b. (a -> b) -> a -> b
$ (Modifier -> Bool)
-> Map Modifier Modifier -> Map Modifier Modifier
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
gtkMods) Map Modifier Modifier
modTable
mods :: [Modifier]
mods | Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
char = (Modifier -> Bool) -> [Modifier] -> [Modifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (Modifier -> Modifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Modifier
MShift) [Modifier]
modsWithShift
| Bool
otherwise = [Modifier]
modsWithShift
key :: Maybe Key
key = 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
Nothing -> Text -> Map Text Key -> Maybe Key
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyVal -> Text
keyName KeyVal
gtkKey) Map Text Key
keyTable
case (Bool
ifIM, Maybe Key
key) of
(True, _ ) -> () -> ReaderT (Ptr EKey) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(_, Nothing) -> Text -> ReaderT (Ptr EKey) IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn (Text -> ReaderT (Ptr EKey) IO ())
-> Text -> ReaderT (Ptr EKey) IO ()
forall a b. (a -> b) -> a -> b
$ "Event not translatable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Key -> Text
forall a. Show a => a -> Text
showT Maybe Key
key
(_, Just k :: Key
k ) -> IO () -> ReaderT (Ptr EKey) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> ReaderT (Ptr EKey) IO ())
-> IO () -> ReaderT (Ptr EKey) IO ()
forall a b. (a -> b) -> a -> b
$ [Event] -> IO ()
ch [Key -> [Modifier] -> Event
Event Key
k [Modifier]
mods]
Bool -> EventM EKey Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
modTable :: M.Map Modifier EventM.Modifier
modTable :: Map Modifier Modifier
modTable = [(Modifier, Modifier)] -> Map Modifier Modifier
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Modifier
MShift, Modifier
EventM.Shift )
, (Modifier
MCtrl, Modifier
EventM.Control)
, (Modifier
MMeta, Modifier
EventM.Alt )
, (Modifier
MSuper, Modifier
EventM.Super )
, (Modifier
MHyper, Modifier
EventM.Hyper )
]
on :: object -> Signal object callback -> callback -> IO ()
on :: object -> Signal object callback -> callback -> IO ()
on widget :: object
widget signal :: Signal object callback
signal handler :: callback
handler = IO (ConnectId object) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ConnectId object) -> IO ()) -> IO (ConnectId object) -> IO ()
forall a b. (a -> b) -> a -> b
$ object
-> Signal object callback -> callback -> IO (ConnectId object)
forall object callback.
object
-> Signal object callback -> callback -> IO (ConnectId object)
Gtk.on object
widget Signal object callback
signal callback
handler
handleButtonClick :: UI -> WindowRef -> EventM EButton Bool
handleButtonClick :: UI -> WindowRef -> EventM EButton Bool
handleButtonClick ui :: UI
ui ref :: WindowRef
ref = do
(x :: DividerPosition
x, y :: DividerPosition
y) <- EventM EButton (DividerPosition, DividerPosition)
forall t.
HasCoordinates t =>
EventM t (DividerPosition, DividerPosition)
eventCoordinates
Click
click <- EventM EButton Click
eventClick
MouseButton
button <- EventM EButton MouseButton
eventButton
IO Bool -> EventM EButton Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> EventM EButton Bool) -> IO Bool -> EventM EButton Bool
forall a b. (a -> b) -> a -> b
$ do
WinInfo
w <- UI -> WindowRef -> IO WinInfo
getWinInfo UI
ui WindowRef
ref
Point
point <- (DividerPosition, DividerPosition) -> WinInfo -> IO Point
pointToOffset (DividerPosition
x, DividerPosition
y) WinInfo
w
let focusWindow :: EditorM ()
focusWindow = WindowRef -> EditorM ()
focusWindowE WindowRef
ref
runAction :: EditorM () -> IO ()
runAction = UI -> Action -> IO ()
uiActionCh UI
ui (Action -> IO ()) -> (EditorM () -> Action) -> EditorM () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction
EditorM () -> IO ()
runAction EditorM ()
focusWindow
Window
win <- IO Window -> IO Window
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Window -> IO Window) -> IO Window -> IO Window
forall a b. (a -> b) -> a -> b
$ IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
w)
let selectRegion :: TextUnit -> IO ()
selectRegion tu :: TextUnit
tu = EditorM () -> IO ()
runAction (EditorM () -> IO ()) -> EditorM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
BufferRef
b <- (Editor -> BufferRef) -> EditorM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Editor -> BufferRef) -> EditorM BufferRef)
-> (Editor -> BufferRef) -> EditorM BufferRef
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey (FBuffer -> BufferRef)
-> (Editor -> FBuffer) -> Editor -> BufferRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win)
Window -> BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
win BufferRef
b (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$
Point -> BufferM ()
moveTo Point
point BufferM () -> BufferM Region -> BufferM Region
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextUnit -> BufferM Region
regionOfB TextUnit
tu BufferM Region -> (Region -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Region -> BufferM ()
setSelectRegionB
case (Click
click, MouseButton
button) of
(SingleClick, LeftButton) -> do
IO () -> IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (WinInfo -> IORef Bool
lButtonPressed WinInfo
w) Bool
True
EditorM () -> IO ()
runAction (EditorM () -> IO ()) -> EditorM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
BufferRef
b <- (Editor -> BufferRef) -> EditorM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Editor -> BufferRef) -> EditorM BufferRef)
-> (Editor -> BufferRef) -> EditorM BufferRef
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey (FBuffer -> BufferRef)
-> (Editor -> FBuffer) -> Editor -> BufferRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win)
Window -> BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
win BufferRef
b (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> 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
point
Point -> BufferM ()
moveTo Point
point
Bool -> BufferM ()
setVisibleSelection Bool
False
(DoubleClick, LeftButton) -> TextUnit -> IO ()
selectRegion TextUnit
unitWord
(TripleClick, LeftButton) -> TextUnit -> IO ()
selectRegion TextUnit
Line
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
handleButtonRelease :: UI -> WinInfo -> EventM EButton Bool
handleButtonRelease :: UI -> WinInfo -> EventM EButton Bool
handleButtonRelease ui :: UI
ui w :: WinInfo
w = do
(x :: DividerPosition
x, y :: DividerPosition
y) <- EventM EButton (DividerPosition, DividerPosition)
forall t.
HasCoordinates t =>
EventM t (DividerPosition, DividerPosition)
eventCoordinates
MouseButton
button <- EventM EButton MouseButton
eventButton
IO () -> ReaderT (Ptr EButton) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> ReaderT (Ptr EButton) IO ())
-> IO () -> ReaderT (Ptr EButton) IO ()
forall a b. (a -> b) -> a -> b
$ do
Point
point <- (DividerPosition, DividerPosition) -> WinInfo -> IO Point
pointToOffset (DividerPosition
x, DividerPosition
y) WinInfo
w
Display
disp <- DrawingArea -> IO Display
forall self. WidgetClass self => self -> IO Display
widgetGetDisplay (DrawingArea -> IO Display) -> DrawingArea -> IO Display
forall a b. (a -> b) -> a -> b
$ WinInfo -> DrawingArea
textview WinInfo
w
Clipboard
cb <- Display -> SelectionTag -> IO Clipboard
clipboardGetForDisplay Display
disp SelectionTag
selectionPrimary
case MouseButton
button of
MiddleButton -> UI -> WinInfo -> Point -> Clipboard -> IO ()
pasteSelectionClipboard UI
ui WinInfo
w Point
point Clipboard
cb
LeftButton -> UI -> WinInfo -> Clipboard -> IO ()
setSelectionClipboard UI
ui WinInfo
w Clipboard
cb IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (WinInfo -> IORef Bool
lButtonPressed WinInfo
w) Bool
False
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> EventM EButton Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
handleScroll :: UI -> WinInfo -> EventM EScroll Bool
handleScroll :: UI -> WinInfo -> EventM EScroll Bool
handleScroll ui :: UI
ui w :: WinInfo
w = do
ScrollDirection
scrollDirection <- EventM EScroll ScrollDirection
eventScrollDirection
(DividerPosition, DividerPosition)
xy <- EventM EScroll (DividerPosition, DividerPosition)
forall t.
HasCoordinates t =>
EventM t (DividerPosition, DividerPosition)
eventCoordinates
IO () -> ReaderT (Ptr EScroll) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> ReaderT (Ptr EScroll) IO ())
-> IO () -> ReaderT (Ptr EScroll) IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
ifPressed <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ WinInfo -> IORef Bool
lButtonPressed WinInfo
w
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
$ TabRef -> BufferM ()
scrollB (TabRef -> BufferM ()) -> TabRef -> BufferM ()
forall a b. (a -> b) -> a -> b
$ case ScrollDirection
scrollDirection of
ScrollUp -> TabRef -> TabRef
forall a. Num a => a -> a
negate TabRef
configAmount
ScrollDown -> TabRef
configAmount
_ -> 0
configAmount :: TabRef
configAmount = UIConfig -> TabRef
configScrollWheelAmount (UIConfig -> TabRef) -> UIConfig -> TabRef
forall a b. (a -> b) -> a -> b
$ UI -> UIConfig
uiConfig UI
ui
UI -> Action -> IO ()
uiActionCh UI
ui (EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA EditorM ()
editorAction)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ifPressed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> WinInfo -> (DividerPosition, DividerPosition) -> IO ()
selectArea UI
ui WinInfo
w (DividerPosition, DividerPosition)
xy
Bool -> EventM EScroll Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
handleConfigure :: UI -> EventM EConfigure Bool
handleConfigure :: UI -> EventM EConfigure Bool
handleConfigure ui :: UI
ui = do
IO () -> ReaderT (Ptr EConfigure) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> ReaderT (Ptr EConfigure) IO ())
-> IO () -> ReaderT (Ptr EConfigure) IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
postGUIAsync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ UI -> Action -> IO ()
uiActionCh UI
ui (EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction (() -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () :: EditorM()))
Bool -> EventM EConfigure Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
handleMove :: UI -> WinInfo -> EventM EMotion Bool
handleMove :: UI -> WinInfo -> EventM EMotion Bool
handleMove ui :: UI
ui w :: WinInfo
w = EventM EMotion (DividerPosition, DividerPosition)
forall t.
HasCoordinates t =>
EventM t (DividerPosition, DividerPosition)
eventCoordinates EventM EMotion (DividerPosition, DividerPosition)
-> ((DividerPosition, DividerPosition)
-> ReaderT (Ptr EMotion) IO ())
-> ReaderT (Ptr EMotion) IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO () -> ReaderT (Ptr EMotion) IO ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> ReaderT (Ptr EMotion) IO ())
-> ((DividerPosition, DividerPosition) -> IO ())
-> (DividerPosition, DividerPosition)
-> ReaderT (Ptr EMotion) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UI -> WinInfo -> (DividerPosition, DividerPosition) -> IO ()
selectArea UI
ui WinInfo
w) ReaderT (Ptr EMotion) IO ()
-> EventM EMotion Bool -> EventM EMotion Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Bool -> EventM EMotion Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
handleDividerMove :: (Action -> IO ()) -> DividerRef -> DividerPosition -> IO ()
handleDividerMove :: (Action -> IO ()) -> TabRef -> DividerPosition -> IO ()
handleDividerMove actionCh :: Action -> IO ()
actionCh ref :: TabRef
ref pos :: DividerPosition
pos =
Action -> IO ()
actionCh (EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction (TabRef -> DividerPosition -> EditorM ()
setDividerPosE TabRef
ref DividerPosition
pos))
pointToOffset :: (Double, Double) -> WinInfo -> IO Point
pointToOffset :: (DividerPosition, DividerPosition) -> WinInfo -> IO Point
pointToOffset (x :: DividerPosition
x,y :: DividerPosition
y) w :: WinInfo
w =
MVar WinLayoutInfo -> (WinLayoutInfo -> IO Point) -> IO Point
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (WinInfo -> MVar WinLayoutInfo
winLayoutInfo WinInfo
w) ((WinLayoutInfo -> IO Point) -> IO Point)
-> (WinLayoutInfo -> IO Point) -> IO Point
forall a b. (a -> b) -> a -> b
$ \WinLayoutInfo{PangoLayout
winLayout :: PangoLayout
winLayout :: WinLayoutInfo -> PangoLayout
winLayout,Point
tos :: Point
tos :: WinLayoutInfo -> Point
tos,Point
bufEnd :: Point
bufEnd :: WinLayoutInfo -> Point
bufEnd} -> do
Bool
im <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Bool
insertingMode WinInfo
w)
(_, charOffsetX :: TabRef
charOffsetX, extra :: TabRef
extra) <- PangoLayout
-> DividerPosition -> DividerPosition -> IO (Bool, TabRef, TabRef)
layoutXYToIndex PangoLayout
winLayout (DividerPosition -> DividerPosition -> DividerPosition
forall a. Ord a => a -> a -> a
max 0 (DividerPosition
xDividerPosition -> DividerPosition -> DividerPosition
forall a. Num a => a -> a -> a
-1)) DividerPosition
y
Point -> IO Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> IO Point) -> Point -> IO Point
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
bufEnd (Point
tos Point -> Point -> Point
forall a. Num a => a -> a -> a
+ TabRef -> Point
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(TabRef
charOffsetX TabRef -> TabRef -> TabRef
forall a. Num a => a -> a -> a
+ if Bool
im then TabRef
extra else 0))
selectArea :: UI -> WinInfo -> (Double, Double) -> IO ()
selectArea :: UI -> WinInfo -> (DividerPosition, DividerPosition) -> IO ()
selectArea ui :: UI
ui w :: WinInfo
w (x :: DividerPosition
x,y :: DividerPosition
y) = do
Point
p <- (DividerPosition, DividerPosition) -> WinInfo -> IO Point
pointToOffset (DividerPosition
x,DividerPosition
y) WinInfo
w
let editorAction :: EditorM ()
editorAction = do
YiString
txt <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> EditorM YiString)
-> BufferM YiString -> EditorM YiString
forall a b. (a -> b) -> a -> b
$ do
Point -> BufferM ()
moveTo Point
p
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
YiString -> EditorM ()
setRegE YiString
txt
UI -> Action -> IO ()
uiActionCh UI
ui (EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction EditorM ()
editorAction)
pasteSelectionClipboard :: UI -> WinInfo -> Point -> Clipboard -> IO ()
pasteSelectionClipboard :: UI -> WinInfo -> Point -> Clipboard -> IO ()
pasteSelectionClipboard ui :: UI
ui w :: WinInfo
w p :: Point
p cb :: Clipboard
cb = do
Window
win <- IO Window -> IO Window
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Window -> IO Window) -> IO Window -> IO Window
forall a b. (a -> b) -> a -> b
$ IORef Window -> IO Window
forall a. IORef a -> IO a
readIORef (WinInfo -> IORef Window
coreWin WinInfo
w)
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) = UI -> Action -> IO ()
uiActionCh UI
ui (Action -> IO ()) -> Action -> IO ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> Action) -> EditorM () -> Action
forall a b. (a -> b) -> a -> b
$ do
BufferRef
b <- (Editor -> BufferRef) -> EditorM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Editor -> BufferRef) -> EditorM BufferRef)
-> (Editor -> BufferRef) -> EditorM BufferRef
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey (FBuffer -> BufferRef)
-> (Editor -> FBuffer) -> Editor -> BufferRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win)
Window -> BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow Window
win BufferRef
b (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
p
YiString -> BufferM ()
insertN YiString
txt
Clipboard -> (Maybe Text -> 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 Text -> Maybe YiString) -> Maybe Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> YiString) -> Maybe Text -> Maybe YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> YiString
R.fromText)
setSelectionClipboard :: UI -> WinInfo -> Clipboard -> IO ()
setSelectionClipboard :: UI -> WinInfo -> Clipboard -> IO ()
setSelectionClipboard ui :: UI
ui _w :: WinInfo
_w cb :: Clipboard
cb = do
IORef Text
selection <- Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
forall a. Monoid a => a
mempty
let yiAction :: YiM ()
yiAction = do
Text
txt <- BufferM Text -> YiM Text
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Text -> YiM Text) -> BufferM Text -> YiM Text
forall a b. (a -> b) -> a -> b
$
(YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> (Region -> BufferM YiString) -> Region -> BufferM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> BufferM YiString
readRegionB (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB :: YiM T.Text
IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Text
selection Text
txt
UI -> Action -> IO ()
uiActionCh UI
ui (Action -> IO ()) -> Action -> IO ()
forall a b. (a -> b) -> a -> b
$ YiM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction YiM ()
yiAction
Text
txt <- IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
selection
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
txt) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Clipboard -> Text -> IO ()
forall self string.
(ClipboardClass self, GlibString string) =>
self -> string -> IO ()
clipboardSetText Clipboard
cb Text
txt