{-# LANGUAGE CPP #-}
module Termonad.Term where
import Termonad.Prelude
import Control.Lens ((^.), (.~), set, to)
import Data.Colour.SRGB (Colour, RGB(RGB), toSRGB)
import Data.FocusList (appendFL, deleteFL, getFocusItemFL)
import GI.Gdk
( EventButton
, EventKey
, RGBA
, getEventButtonButton
, newZeroRGBA
, setRGBABlue
, setRGBAGreen
, setRGBARed
)
import GI.Gdk.Constants (pattern BUTTON_SECONDARY)
import GI.Gio
( Cancellable
, menuAppend
, menuNew
)
import GI.GLib
( SpawnFlags(SpawnFlagsDefault)
)
import GI.Gtk
( Adjustment
, Align(AlignFill)
, ApplicationWindow
, Box
, Button
, IconSize(IconSizeMenu)
, Label
, Notebook
, Orientation(OrientationHorizontal)
, PolicyType(PolicyTypeAlways, PolicyTypeAutomatic, PolicyTypeNever)
, ReliefStyle(ReliefStyleNone)
, ResponseType(ResponseTypeNo, ResponseTypeYes)
, ScrolledWindow
, applicationGetActiveWindow
, boxNew
, buttonNewFromIconName
, buttonSetRelief
, containerAdd
, dialogAddButton
, dialogGetContentArea
, dialogNew
, dialogRun
, labelNew
, labelSetEllipsize
, labelSetLabel
, labelSetMaxWidthChars
, menuAttachToWidget
, menuNewFromModel
, menuPopupAtPointer
, notebookAppendPage
, notebookDetachTab
, notebookGetNPages
, notebookPageNum
, notebookSetCurrentPage
, notebookSetShowTabs
, notebookSetTabReorderable
, onButtonClicked
, onWidgetButtonPressEvent
, onWidgetKeyPressEvent
, scrolledWindowNew
, scrolledWindowSetPolicy
, setWidgetMargin
, widgetDestroy
, widgetGrabFocus
, widgetSetCanFocus
, widgetSetHalign
, widgetSetHexpand
, widgetShow
, windowSetFocus
, windowSetTransientFor
)
import GI.Pango (EllipsizeMode(EllipsizeModeMiddle), FontDescription)
import GI.Vte
( PtyFlags(PtyFlagsDefault)
, Terminal
, onTerminalChildExited
, onTerminalWindowTitleChanged
, terminalGetWindowTitle
, terminalNew
, terminalSetCursorBlinkMode
, terminalSetFont
, terminalSetScrollbackLines
, terminalSpawnSync
, terminalSetWordCharExceptions
)
import System.Directory (getSymbolicLinkTarget)
import System.Environment (lookupEnv)
import Termonad.Lenses
( lensConfirmExit
, lensOptions
, lensShowScrollbar
, lensShowTabBar
, lensTMNotebookTabLabel
, lensTMNotebookTabTerm
, lensTMNotebookTabTermContainer
, lensTMNotebookTabs
, lensTMStateApp
, lensTMStateConfig
, lensTMStateNotebook
, lensTerm
)
import Termonad.Types
( ConfigHooks(createTermHook)
, ConfigOptions(scrollbackLen, wordCharExceptions, cursorBlinkMode)
, ShowScrollbar(..)
, ShowTabBar(..)
, TMConfig(hooks, options)
, TMNotebook
, TMNotebookTab
, TMState
, TMState'(TMState, tmStateAppWin, tmStateConfig, tmStateFontDesc, tmStateNotebook)
, TMTerm
, assertInvariantTMState
, createTMNotebookTab
, newTMTerm
, pid
, tmNotebook
, tmNotebookTabTerm
, tmNotebookTabTermContainer
, tmNotebookTabs
)
focusTerm :: Int -> TMState -> IO ()
focusTerm :: Int -> TMState -> IO ()
focusTerm i :: Int
i mvarTMState :: TMState
mvarTMState = do
Notebook
note <- TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook)
-> (TMState' -> TMNotebook) -> TMState' -> Notebook
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TMState' -> TMNotebook
tmStateNotebook (TMState' -> Notebook) -> IO TMState' -> IO Notebook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
Notebook -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Int32 -> m ()
notebookSetCurrentPage Notebook
note (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
altNumSwitchTerm :: Int -> TMState -> IO ()
altNumSwitchTerm :: Int -> TMState -> IO ()
altNumSwitchTerm = Int -> TMState -> IO ()
focusTerm
termExitFocused :: TMState -> IO ()
termExitFocused :: TMState -> IO ()
termExitFocused mvarTMState :: TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let maybeTab :: Maybe TMNotebookTab
maybeTab =
TMState'
tmState TMState'
-> Getting (Maybe TMNotebookTab) TMState' (Maybe TMNotebookTab)
-> Maybe TMNotebookTab
forall s a. s -> Getting a s a -> a
^. (TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
-> TMState' -> Const (Maybe TMNotebookTab) TMState'
Lens' TMState' TMNotebook
lensTMStateNotebook ((TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
-> TMState' -> Const (Maybe TMNotebookTab) TMState')
-> ((Maybe TMNotebookTab
-> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
-> TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
-> Getting (Maybe TMNotebookTab) TMState' (Maybe TMNotebookTab)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FocusList TMNotebookTab
-> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab))
-> TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook
Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs ((FocusList TMNotebookTab
-> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab))
-> TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
-> ((Maybe TMNotebookTab
-> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
-> FocusList TMNotebookTab
-> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab))
-> (Maybe TMNotebookTab
-> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
-> TMNotebook
-> Const (Maybe TMNotebookTab) TMNotebook
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FocusList TMNotebookTab -> Maybe TMNotebookTab)
-> (Maybe TMNotebookTab
-> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
-> FocusList TMNotebookTab
-> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to FocusList TMNotebookTab -> Maybe TMNotebookTab
forall a. FocusList a -> Maybe a
getFocusItemFL
case Maybe TMNotebookTab
maybeTab of
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just tab :: TMNotebookTab
tab -> TMNotebookTab -> TMState -> IO ()
termClose TMNotebookTab
tab TMState
mvarTMState
termClose :: TMNotebookTab -> TMState -> IO ()
termClose :: TMNotebookTab -> TMState -> IO ()
termClose tab :: TMNotebookTab
tab mvarTMState :: TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let confirm :: Bool
confirm = TMState'
tmState TMState' -> Getting Bool TMState' Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (TMConfig -> Const Bool TMConfig)
-> TMState' -> Const Bool TMState'
Lens' TMState' TMConfig
lensTMStateConfig ((TMConfig -> Const Bool TMConfig)
-> TMState' -> Const Bool TMState')
-> ((Bool -> Const Bool Bool) -> TMConfig -> Const Bool TMConfig)
-> Getting Bool TMState' Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ConfigOptions -> Const Bool ConfigOptions)
-> TMConfig -> Const Bool TMConfig
Lens' TMConfig ConfigOptions
lensOptions ((ConfigOptions -> Const Bool ConfigOptions)
-> TMConfig -> Const Bool TMConfig)
-> ((Bool -> Const Bool Bool)
-> ConfigOptions -> Const Bool ConfigOptions)
-> (Bool -> Const Bool Bool)
-> TMConfig
-> Const Bool TMConfig
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Bool -> Const Bool Bool)
-> ConfigOptions -> Const Bool ConfigOptions
Lens' ConfigOptions Bool
lensConfirmExit
close :: TMNotebookTab -> TMState -> IO ()
close = if Bool
confirm then TMNotebookTab -> TMState -> IO ()
termExitWithConfirmation else TMNotebookTab -> TMState -> IO ()
termExit
TMNotebookTab -> TMState -> IO ()
close TMNotebookTab
tab TMState
mvarTMState
termExitWithConfirmation :: TMNotebookTab -> TMState -> IO ()
termExitWithConfirmation :: TMNotebookTab -> TMState -> IO ()
termExitWithConfirmation tab :: TMNotebookTab
tab mvarTMState :: TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let app :: Application
app = TMState'
tmState TMState' -> Getting Application TMState' Application -> Application
forall s a. s -> Getting a s a -> a
^. Getting Application TMState' Application
Lens' TMState' Application
lensTMStateApp
Maybe Window
win <- Application -> IO (Maybe Window)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
Dialog
dialog <- IO Dialog
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Dialog
dialogNew
Box
box <- Dialog -> IO Box
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Box
dialogGetContentArea Dialog
dialog
Label
label <- Maybe Text -> IO Label
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
labelNew (Text -> Maybe Text
forall a. a -> Maybe a
Just "Close tab?")
Box -> Label -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Box
box Label
label
Label -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Label
label
Label -> Int32 -> IO ()
forall (m :: * -> *) o.
(MonadIO m, IsWidget o) =>
o -> Int32 -> m ()
setWidgetMargin Label
label 10
IO Widget -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Widget -> IO ()) -> IO Widget -> IO ()
forall a b. (a -> b) -> a -> b
$
Dialog -> Text -> Int32 -> IO Widget
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Text -> Int32 -> m Widget
dialogAddButton
Dialog
dialog
"No, do NOT close tab"
(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ResponseType -> Int
forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeNo))
IO Widget -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Widget -> IO ()) -> IO Widget -> IO ()
forall a b. (a -> b) -> a -> b
$
Dialog -> Text -> Int32 -> IO Widget
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Text -> Int32 -> m Widget
dialogAddButton
Dialog
dialog
"Yes, close tab"
(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ResponseType -> Int
forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeYes))
Dialog -> Maybe Window -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWindow b) =>
a -> Maybe b -> m ()
windowSetTransientFor Dialog
dialog Maybe Window
win
Int32
res <- Dialog -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun Dialog
dialog
Dialog -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy Dialog
dialog
case Int -> ResponseType
forall a. Enum a => Int -> a
toEnum (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
res) of
ResponseTypeYes -> TMNotebookTab -> TMState -> IO ()
termExit TMNotebookTab
tab TMState
mvarTMState
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
termExit :: TMNotebookTab -> TMState -> IO ()
termExit :: TMNotebookTab -> TMState -> IO ()
termExit tab :: TMNotebookTab
tab mvarTMState :: TMState
mvarTMState = do
IO ()
detachTabAction <-
TMState -> (TMState' -> IO (TMState', IO ())) -> IO (IO ())
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar TMState
mvarTMState ((TMState' -> IO (TMState', IO ())) -> IO (IO ()))
-> (TMState' -> IO (TMState', IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \tmState :: TMState'
tmState -> do
let notebook :: TMNotebook
notebook = TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
detachTabAction :: IO ()
detachTabAction =
Notebook -> ScrolledWindow -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
a -> b -> m ()
notebookDetachTab
(TMNotebook -> Notebook
tmNotebook TMNotebook
notebook)
(TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer TMNotebookTab
tab)
let newTabs :: FocusList TMNotebookTab
newTabs = TMNotebookTab -> FocusList TMNotebookTab -> FocusList TMNotebookTab
forall a. Eq a => a -> FocusList a -> FocusList a
deleteFL TMNotebookTab
tab (TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
notebook)
let newTMState :: TMState'
newTMState =
ASetter
TMState'
TMState'
(FocusList TMNotebookTab)
(FocusList TMNotebookTab)
-> FocusList TMNotebookTab -> TMState' -> TMState'
forall s t a b. ASetter s t a b -> b -> s -> t
set ((TMNotebook -> Identity TMNotebook)
-> TMState' -> Identity TMState'
Lens' TMState' TMNotebook
lensTMStateNotebook ((TMNotebook -> Identity TMNotebook)
-> TMState' -> Identity TMState')
-> ((FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
-> TMNotebook -> Identity TMNotebook)
-> ASetter
TMState'
TMState'
(FocusList TMNotebookTab)
(FocusList TMNotebookTab)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
-> TMNotebook -> Identity TMNotebook
Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs) FocusList TMNotebookTab
newTabs TMState'
tmState
(TMState', IO ()) -> IO (TMState', IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TMState'
newTMState, IO ()
detachTabAction)
IO ()
detachTabAction
TMState -> IO ()
relabelTabs TMState
mvarTMState
relabelTabs :: TMState -> IO ()
relabelTabs :: TMState -> IO ()
relabelTabs mvarTMState :: TMState
mvarTMState = do
TMState{TMNotebook
tmStateNotebook :: TMNotebook
tmStateNotebook :: TMState' -> TMNotebook
tmStateNotebook} <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let notebook :: Notebook
notebook = TMNotebook -> Notebook
tmNotebook TMNotebook
tmStateNotebook
tabFocusList :: FocusList TMNotebookTab
tabFocusList = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
tmStateNotebook
(Element (FocusList TMNotebookTab) -> IO ())
-> FocusList TMNotebookTab -> IO ()
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
foldMap (Notebook -> TMNotebookTab -> IO ()
go Notebook
notebook) FocusList TMNotebookTab
tabFocusList
where
go :: Notebook -> TMNotebookTab -> IO ()
go :: Notebook -> TMNotebookTab -> IO ()
go notebook :: Notebook
notebook tmNotebookTab :: TMNotebookTab
tmNotebookTab = do
let label :: Label
label = TMNotebookTab
tmNotebookTab TMNotebookTab -> Getting Label TMNotebookTab Label -> Label
forall s a. s -> Getting a s a -> a
^. Getting Label TMNotebookTab Label
Lens' TMNotebookTab Label
lensTMNotebookTabLabel
scrolledWin :: ScrolledWindow
scrolledWin = TMNotebookTab
tmNotebookTab TMNotebookTab
-> Getting ScrolledWindow TMNotebookTab ScrolledWindow
-> ScrolledWindow
forall s a. s -> Getting a s a -> a
^. Getting ScrolledWindow TMNotebookTab ScrolledWindow
Lens' TMNotebookTab ScrolledWindow
lensTMNotebookTabTermContainer
term' :: Terminal
term' = TMNotebookTab
tmNotebookTab TMNotebookTab
-> Getting Terminal TMNotebookTab Terminal -> Terminal
forall s a. s -> Getting a s a -> a
^. (TMTerm -> Const Terminal TMTerm)
-> TMNotebookTab -> Const Terminal TMNotebookTab
Lens' TMNotebookTab TMTerm
lensTMNotebookTabTerm ((TMTerm -> Const Terminal TMTerm)
-> TMNotebookTab -> Const Terminal TMNotebookTab)
-> ((Terminal -> Const Terminal Terminal)
-> TMTerm -> Const Terminal TMTerm)
-> Getting Terminal TMNotebookTab Terminal
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Terminal -> Const Terminal Terminal)
-> TMTerm -> Const Terminal TMTerm
Lens' TMTerm Terminal
lensTerm
Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
relabelTab Notebook
notebook Label
label ScrolledWindow
scrolledWin Terminal
term'
computeTabLabel
:: Int
-> Maybe Text
-> Text
computeTabLabel :: Int -> Maybe Text -> Text
computeTabLabel pageNum :: Int
pageNum maybeTitle :: Maybe Text
maybeTitle =
let title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "shell" Maybe Text
maybeTitle
in Int -> Text
forall a. Show a => a -> Text
tshow (Int
pageNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
title
relabelTab :: Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
relabelTab :: Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
relabelTab notebook :: Notebook
notebook label :: Label
label scrolledWin :: ScrolledWindow
scrolledWin term' :: Terminal
term' = do
Int32
tabNum <- Notebook -> ScrolledWindow -> IO Int32
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
a -> b -> m Int32
notebookPageNum Notebook
notebook ScrolledWindow
scrolledWin
Maybe Text
maybeTitle <- Terminal -> IO (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> m (Maybe Text)
terminalGetWindowTitle Terminal
term'
let labelText :: Text
labelText = Int -> Maybe Text -> Text
computeTabLabel (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
tabNum) Maybe Text
maybeTitle
Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
labelSetLabel Label
label Text
labelText
showScrollbarToPolicy :: ShowScrollbar -> PolicyType
showScrollbarToPolicy :: ShowScrollbar -> PolicyType
showScrollbarToPolicy ShowScrollbarNever = PolicyType
PolicyTypeNever
showScrollbarToPolicy ShowScrollbarIfNeeded = PolicyType
PolicyTypeAutomatic
showScrollbarToPolicy ShowScrollbarAlways = PolicyType
PolicyTypeAlways
createScrolledWin :: TMState -> IO ScrolledWindow
createScrolledWin :: TMState -> IO ScrolledWindow
createScrolledWin mvarTMState :: TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let showScrollbarVal :: ShowScrollbar
showScrollbarVal =
TMState'
tmState TMState'
-> Getting ShowScrollbar TMState' ShowScrollbar -> ShowScrollbar
forall s a. s -> Getting a s a -> a
^. (TMConfig -> Const ShowScrollbar TMConfig)
-> TMState' -> Const ShowScrollbar TMState'
Lens' TMState' TMConfig
lensTMStateConfig ((TMConfig -> Const ShowScrollbar TMConfig)
-> TMState' -> Const ShowScrollbar TMState')
-> ((ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
-> TMConfig -> Const ShowScrollbar TMConfig)
-> Getting ShowScrollbar TMState' ShowScrollbar
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ConfigOptions -> Const ShowScrollbar ConfigOptions)
-> TMConfig -> Const ShowScrollbar TMConfig
Lens' TMConfig ConfigOptions
lensOptions ((ConfigOptions -> Const ShowScrollbar ConfigOptions)
-> TMConfig -> Const ShowScrollbar TMConfig)
-> ((ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
-> ConfigOptions -> Const ShowScrollbar ConfigOptions)
-> (ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
-> TMConfig
-> Const ShowScrollbar TMConfig
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
-> ConfigOptions -> Const ShowScrollbar ConfigOptions
Lens' ConfigOptions ShowScrollbar
lensShowScrollbar
vScrollbarPolicy :: PolicyType
vScrollbarPolicy = ShowScrollbar -> PolicyType
showScrollbarToPolicy ShowScrollbar
showScrollbarVal
ScrolledWindow
scrolledWin <-
Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAdjustment a, IsAdjustment b) =>
Maybe a -> Maybe b -> m ScrolledWindow
scrolledWindowNew
(Maybe Adjustment
forall a. Maybe a
Nothing :: Maybe Adjustment)
(Maybe Adjustment
forall a. Maybe a
Nothing :: Maybe Adjustment)
ScrolledWindow -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow ScrolledWindow
scrolledWin
ScrolledWindow -> PolicyType -> PolicyType -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScrolledWindow a) =>
a -> PolicyType -> PolicyType -> m ()
scrolledWindowSetPolicy ScrolledWindow
scrolledWin PolicyType
PolicyTypeAutomatic PolicyType
vScrollbarPolicy
ScrolledWindow -> IO ScrolledWindow
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScrolledWindow
scrolledWin
createNotebookTabLabel :: IO (Box, Label, Button)
createNotebookTabLabel :: IO (Box, Label, Button)
createNotebookTabLabel = do
Box
box <- Orientation -> Int32 -> IO Box
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Orientation -> Int32 -> m Box
boxNew Orientation
OrientationHorizontal 5
Label
label <- Maybe Text -> IO Label
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
labelNew (Text -> Maybe Text
forall a. a -> Maybe a
Just "")
Label -> EllipsizeMode -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> EllipsizeMode -> m ()
labelSetEllipsize Label
label EllipsizeMode
EllipsizeModeMiddle
Label -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Int32 -> m ()
labelSetMaxWidthChars Label
label 10
Label -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetHexpand Label
label Bool
True
Label -> Align -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Align -> m ()
widgetSetHalign Label
label Align
AlignFill
Button
button <-
Maybe Text -> Int32 -> IO Button
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Int32 -> m Button
buttonNewFromIconName
(Text -> Maybe Text
forall a. a -> Maybe a
Just "window-close")
(Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IconSize -> Int
forall a. Enum a => a -> Int
fromEnum IconSize
IconSizeMenu))
Button -> ReliefStyle -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsButton a) =>
a -> ReliefStyle -> m ()
buttonSetRelief Button
button ReliefStyle
ReliefStyleNone
Box -> Label -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Box
box Label
label
Box -> Button -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Box
box Button
button
Button -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetCanFocus Button
button Bool
False
Label -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetCanFocus Label
label Bool
False
Box -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetCanFocus Box
box Bool
False
Box -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Box
box
Label -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Label
label
Button -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Button
button
(Box, Label, Button) -> IO (Box, Label, Button)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Box
box, Label
label, Button
button)
setShowTabs :: TMConfig -> Notebook -> IO ()
setShowTabs :: TMConfig -> Notebook -> IO ()
setShowTabs tmConfig :: TMConfig
tmConfig note :: Notebook
note = do
Int32
npages <- Notebook -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> m Int32
notebookGetNPages Notebook
note
let shouldShowTabs :: Bool
shouldShowTabs =
case TMConfig
tmConfig TMConfig -> Getting ShowTabBar TMConfig ShowTabBar -> ShowTabBar
forall s a. s -> Getting a s a -> a
^. (ConfigOptions -> Const ShowTabBar ConfigOptions)
-> TMConfig -> Const ShowTabBar TMConfig
Lens' TMConfig ConfigOptions
lensOptions ((ConfigOptions -> Const ShowTabBar ConfigOptions)
-> TMConfig -> Const ShowTabBar TMConfig)
-> ((ShowTabBar -> Const ShowTabBar ShowTabBar)
-> ConfigOptions -> Const ShowTabBar ConfigOptions)
-> Getting ShowTabBar TMConfig ShowTabBar
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ShowTabBar -> Const ShowTabBar ShowTabBar)
-> ConfigOptions -> Const ShowTabBar ConfigOptions
Lens' ConfigOptions ShowTabBar
lensShowTabBar of
ShowTabBarIfNeeded -> Int32
npages Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> 1
ShowTabBarAlways -> Bool
True
ShowTabBarNever -> Bool
False
Notebook -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Bool -> m ()
notebookSetShowTabs Notebook
note Bool
shouldShowTabs
toRGBA :: Colour Double -> IO RGBA
toRGBA :: Colour Double -> IO RGBA
toRGBA colour :: Colour Double
colour = do
let RGB red :: Double
red green :: Double
green blue :: Double
blue = Colour Double -> RGB Double
forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB Colour Double
colour
RGBA
rgba <- IO RGBA
forall (m :: * -> *). MonadIO m => m RGBA
newZeroRGBA
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBARed RGBA
rgba Double
red
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBAGreen RGBA
rgba Double
green
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
setRGBABlue RGBA
rgba Double
blue
RGBA -> IO RGBA
forall (f :: * -> *) a. Applicative f => a -> f a
pure RGBA
rgba
cwdOfPid :: Int -> IO (Maybe Text)
cwdOfPid :: Int -> IO (Maybe Text)
cwdOfPid pd :: Int
pd = do
#ifdef mingw32_HOST_OS
pure Nothing
#else
#ifdef darwin_HOST_OS
pure Nothing
#else
let pidPath :: FilePath
pidPath = "/proc" FilePath -> FilePath -> FilePath
</> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
pd FilePath -> FilePath -> FilePath
</> "cwd"
Either IOException FilePath
eitherLinkTarget <- IO FilePath -> IO (Either IOException FilePath)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO FilePath -> IO (Either IOException FilePath))
-> IO FilePath -> IO (Either IOException FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
pidPath
case Either IOException FilePath
eitherLinkTarget of
Left (IOException
_ :: IOException) -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
Right linkTarget :: FilePath
linkTarget -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack FilePath
[Element Text]
linkTarget
#endif
#endif
getCWDFromFocusedTab :: TMNotebook -> IO (Maybe Text)
getCWDFromFocusedTab :: TMNotebook -> IO (Maybe Text)
getCWDFromFocusedTab currNote :: TMNotebook
currNote = do
let maybeFocusedTab :: Maybe TMNotebookTab
maybeFocusedTab = FocusList TMNotebookTab -> Maybe TMNotebookTab
forall a. FocusList a -> Maybe a
getFocusItemFL (TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
currNote)
case Maybe TMNotebookTab
maybeFocusedTab of
Nothing -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
Just focusedNotebookTab :: TMNotebookTab
focusedNotebookTab -> do
let shellPid :: Int
shellPid = TMTerm -> Int
pid (TMNotebookTab -> TMTerm
tmNotebookTabTerm TMNotebookTab
focusedNotebookTab)
Int -> IO (Maybe Text)
cwdOfPid Int
shellPid
createAndInitVteTerm :: FontDescription -> ConfigOptions -> IO Terminal
createAndInitVteTerm :: FontDescription -> ConfigOptions -> IO Terminal
createAndInitVteTerm tmStateFontDesc :: FontDescription
tmStateFontDesc curOpts :: ConfigOptions
curOpts = do
Terminal
vteTerm <- IO Terminal
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Terminal
terminalNew
Terminal -> Maybe FontDescription -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe FontDescription -> m ()
terminalSetFont Terminal
vteTerm (FontDescription -> Maybe FontDescription
forall a. a -> Maybe a
Just FontDescription
tmStateFontDesc)
Terminal -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Text -> m ()
terminalSetWordCharExceptions Terminal
vteTerm (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Text
wordCharExceptions ConfigOptions
curOpts
Terminal -> CLong -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> CLong -> m ()
terminalSetScrollbackLines Terminal
vteTerm (Integer -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConfigOptions -> Integer
scrollbackLen ConfigOptions
curOpts))
Terminal -> CursorBlinkMode -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> CursorBlinkMode -> m ()
terminalSetCursorBlinkMode Terminal
vteTerm (ConfigOptions -> CursorBlinkMode
cursorBlinkMode ConfigOptions
curOpts)
Terminal -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Terminal
vteTerm
Terminal -> IO Terminal
forall (f :: * -> *) a. Applicative f => a -> f a
pure Terminal
vteTerm
launchShell
:: Terminal
-> Maybe Text
-> IO Int
launchShell :: Terminal -> Maybe Text -> IO Int
launchShell vteTerm :: Terminal
vteTerm maybeCurrDir :: Maybe Text
maybeCurrDir = do
Maybe FilePath
mShell <- FilePath -> IO (Maybe FilePath)
lookupEnv "SHELL"
let argv :: [FilePath]
argv = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe ["/usr/bin/env", "bash"] (FilePath -> [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [FilePath]) -> Maybe FilePath -> Maybe [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
mShell)
Int32
shellPid <-
Terminal
-> [PtyFlags]
-> Maybe Text
-> [FilePath]
-> Maybe [FilePath]
-> [SpawnFlags]
-> Maybe (IO ())
-> Maybe Cancellable
-> IO Int32
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTerminal a, IsCancellable b) =>
a
-> [PtyFlags]
-> Maybe Text
-> [FilePath]
-> Maybe [FilePath]
-> [SpawnFlags]
-> Maybe (IO ())
-> Maybe b
-> m Int32
terminalSpawnSync
Terminal
vteTerm
[Item [PtyFlags]
PtyFlags
PtyFlagsDefault]
Maybe Text
maybeCurrDir
[FilePath]
argv
Maybe [FilePath]
forall a. Maybe a
Nothing
([Item [SpawnFlags]
SpawnFlags
SpawnFlagsDefault] :: [SpawnFlags])
Maybe (IO ())
forall a. Maybe a
Nothing
(Maybe Cancellable
forall a. Maybe a
Nothing :: Maybe Cancellable)
Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
shellPid)
addPage
:: TMState
-> TMNotebookTab
-> Box
-> IO ()
addPage :: TMState -> TMNotebookTab -> Box -> IO ()
addPage mvarTMState :: TMState
mvarTMState notebookTab :: TMNotebookTab
notebookTab tabLabelBox :: Box
tabLabelBox = do
(note :: Notebook
note, pageIndex :: Int32
pageIndex) <- TMState
-> (TMState' -> IO (TMState', (Notebook, Int32)))
-> IO (Notebook, Int32)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar TMState
mvarTMState TMState' -> IO (TMState', (Notebook, Int32))
appendNotebookPage
Notebook -> Int32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Int32 -> m ()
notebookSetCurrentPage Notebook
note Int32
pageIndex
where
appendNotebookPage :: TMState' -> IO (TMState', (Notebook, Int32))
appendNotebookPage :: TMState' -> IO (TMState', (Notebook, Int32))
appendNotebookPage tmState :: TMState'
tmState = do
let notebook :: TMNotebook
notebook = TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
note :: Notebook
note = TMNotebook -> Notebook
tmNotebook TMNotebook
notebook
tabs :: FocusList TMNotebookTab
tabs = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
notebook
scrolledWin :: ScrolledWindow
scrolledWin = TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer TMNotebookTab
notebookTab
Int32
pageIndex <- Notebook -> ScrolledWindow -> Maybe Box -> IO Int32
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> m Int32
notebookAppendPage Notebook
note ScrolledWindow
scrolledWin (Box -> Maybe Box
forall a. a -> Maybe a
Just Box
tabLabelBox)
Notebook -> ScrolledWindow -> Bool -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
a -> b -> Bool -> m ()
notebookSetTabReorderable Notebook
note ScrolledWindow
scrolledWin Bool
True
TMConfig -> Notebook -> IO ()
setShowTabs (TMState'
tmState TMState' -> Getting TMConfig TMState' TMConfig -> TMConfig
forall s a. s -> Getting a s a -> a
^. Getting TMConfig TMState' TMConfig
Lens' TMState' TMConfig
lensTMStateConfig) Notebook
note
let newTabs :: FocusList TMNotebookTab
newTabs = FocusList TMNotebookTab -> TMNotebookTab -> FocusList TMNotebookTab
forall a. FocusList a -> a -> FocusList a
appendFL FocusList TMNotebookTab
tabs TMNotebookTab
notebookTab
newTMState :: TMState'
newTMState =
TMState'
tmState TMState' -> (TMState' -> TMState') -> TMState'
forall a b. a -> (a -> b) -> b
& (TMNotebook -> Identity TMNotebook)
-> TMState' -> Identity TMState'
Lens' TMState' TMNotebook
lensTMStateNotebook ((TMNotebook -> Identity TMNotebook)
-> TMState' -> Identity TMState')
-> ((FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
-> TMNotebook -> Identity TMNotebook)
-> ASetter
TMState'
TMState'
(FocusList TMNotebookTab)
(FocusList TMNotebookTab)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
-> TMNotebook -> Identity TMNotebook
Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs ASetter
TMState'
TMState'
(FocusList TMNotebookTab)
(FocusList TMNotebookTab)
-> FocusList TMNotebookTab -> TMState' -> TMState'
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FocusList TMNotebookTab
newTabs
(TMState', (Notebook, Int32)) -> IO (TMState', (Notebook, Int32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TMState'
newTMState, (Notebook
note, Int32
pageIndex))
setFocusOn :: ApplicationWindow -> Terminal -> IO()
setFocusOn :: ApplicationWindow -> Terminal -> IO ()
setFocusOn tmStateAppWin :: ApplicationWindow
tmStateAppWin vteTerm :: Terminal
vteTerm = do
Terminal -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetGrabFocus Terminal
vteTerm
ApplicationWindow -> Maybe Terminal -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWidget b) =>
a -> Maybe b -> m ()
windowSetFocus ApplicationWindow
tmStateAppWin (Terminal -> Maybe Terminal
forall a. a -> Maybe a
Just Terminal
vteTerm)
createTerm
:: (TMState -> EventKey -> IO Bool)
-> TMState
-> IO TMTerm
createTerm :: (TMState -> EventKey -> IO Bool) -> TMState -> IO TMTerm
createTerm handleKeyPress :: TMState -> EventKey -> IO Bool
handleKeyPress mvarTMState :: TMState
mvarTMState = do
TMState -> IO ()
assertInvariantTMState TMState
mvarTMState
TMState{ApplicationWindow
tmStateAppWin :: ApplicationWindow
tmStateAppWin :: TMState' -> ApplicationWindow
tmStateAppWin, FontDescription
tmStateFontDesc :: FontDescription
tmStateFontDesc :: TMState' -> FontDescription
tmStateFontDesc, TMConfig
tmStateConfig :: TMConfig
tmStateConfig :: TMState' -> TMConfig
tmStateConfig, tmStateNotebook :: TMState' -> TMNotebook
tmStateNotebook=TMNotebook
currNote} <-
TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
Terminal
vteTerm <- FontDescription -> ConfigOptions -> IO Terminal
createAndInitVteTerm FontDescription
tmStateFontDesc (TMConfig -> ConfigOptions
options TMConfig
tmStateConfig)
Maybe Text
maybeCurrDir <- TMNotebook -> IO (Maybe Text)
getCWDFromFocusedTab TMNotebook
currNote
Int
termShellPid <- Terminal -> Maybe Text -> IO Int
launchShell Terminal
vteTerm Maybe Text
maybeCurrDir
TMTerm
tmTerm <- Terminal -> Int -> IO TMTerm
newTMTerm Terminal
vteTerm Int
termShellPid
ScrolledWindow
scrolledWin <- TMState -> IO ScrolledWindow
createScrolledWin TMState
mvarTMState
ScrolledWindow -> Terminal -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd ScrolledWindow
scrolledWin Terminal
vteTerm
(tabLabelBox :: Box
tabLabelBox, tabLabel :: Label
tabLabel, tabCloseButton :: Button
tabCloseButton) <- IO (Box, Label, Button)
createNotebookTabLabel
let notebookTab :: TMNotebookTab
notebookTab = Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
createTMNotebookTab Label
tabLabel ScrolledWindow
scrolledWin TMTerm
tmTerm
TMState -> TMNotebookTab -> Box -> IO ()
addPage TMState
mvarTMState TMNotebookTab
notebookTab Box
tabLabelBox
Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
relabelTab (TMNotebook -> Notebook
tmNotebook TMNotebook
currNote) Label
tabLabel ScrolledWindow
scrolledWin Terminal
vteTerm
IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ Button -> IO () -> IO SignalHandlerId
forall a (m :: * -> *).
(IsButton a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onButtonClicked Button
tabCloseButton (IO () -> IO SignalHandlerId) -> IO () -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ TMNotebookTab -> TMState -> IO ()
termClose TMNotebookTab
notebookTab TMState
mvarTMState
IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ Terminal -> IO () -> IO SignalHandlerId
forall a (m :: * -> *).
(IsTerminal a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onTerminalWindowTitleChanged Terminal
vteTerm (IO () -> IO SignalHandlerId) -> IO () -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
TMState{TMNotebook
tmStateNotebook :: TMNotebook
tmStateNotebook :: TMState' -> TMNotebook
tmStateNotebook} <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let notebook :: Notebook
notebook = TMNotebook -> Notebook
tmNotebook TMNotebook
tmStateNotebook
Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
relabelTab Notebook
notebook Label
tabLabel ScrolledWindow
scrolledWin Terminal
vteTerm
IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ Terminal -> (EventKey -> IO Bool) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> (EventKey -> IO Bool) -> m SignalHandlerId
onWidgetKeyPressEvent Terminal
vteTerm ((EventKey -> IO Bool) -> IO SignalHandlerId)
-> (EventKey -> IO Bool) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ TMState -> EventKey -> IO Bool
handleKeyPress TMState
mvarTMState
IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ ScrolledWindow -> (EventKey -> IO Bool) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> (EventKey -> IO Bool) -> m SignalHandlerId
onWidgetKeyPressEvent ScrolledWindow
scrolledWin ((EventKey -> IO Bool) -> IO SignalHandlerId)
-> (EventKey -> IO Bool) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ TMState -> EventKey -> IO Bool
handleKeyPress TMState
mvarTMState
IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ Terminal -> WidgetButtonPressEventCallback -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> WidgetButtonPressEventCallback -> m SignalHandlerId
onWidgetButtonPressEvent Terminal
vteTerm (WidgetButtonPressEventCallback -> IO SignalHandlerId)
-> WidgetButtonPressEventCallback -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ Terminal -> WidgetButtonPressEventCallback
handleMousePress Terminal
vteTerm
IO SignalHandlerId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO SignalHandlerId -> IO ()) -> IO SignalHandlerId -> IO ()
forall a b. (a -> b) -> a -> b
$ Terminal -> (Int32 -> IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsTerminal a, MonadIO m) =>
a -> (Int32 -> IO ()) -> m SignalHandlerId
onTerminalChildExited Terminal
vteTerm ((Int32 -> IO ()) -> IO SignalHandlerId)
-> (Int32 -> IO ()) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ \_ -> TMNotebookTab -> TMState -> IO ()
termExit TMNotebookTab
notebookTab TMState
mvarTMState
ApplicationWindow -> Terminal -> IO ()
setFocusOn ApplicationWindow
tmStateAppWin Terminal
vteTerm
TMState -> IO ()
assertInvariantTMState TMState
mvarTMState
ConfigHooks -> TMState -> Terminal -> IO ()
createTermHook (TMConfig -> ConfigHooks
hooks TMConfig
tmStateConfig) TMState
mvarTMState Terminal
vteTerm
TMTerm -> IO TMTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMTerm
tmTerm
handleMousePress :: Terminal -> EventButton -> IO Bool
handleMousePress :: Terminal -> WidgetButtonPressEventCallback
handleMousePress vteTerm :: Terminal
vteTerm event :: EventButton
event = do
Word32
button <- EventButton -> IO Word32
forall (m :: * -> *). MonadIO m => EventButton -> m Word32
getEventButtonButton EventButton
event
let rightClick :: Bool
rightClick = Word32
button Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
BUTTON_SECONDARY
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
rightClick (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Menu
menuModel <- IO Menu
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Menu
menuNew
Menu -> Maybe Text -> Maybe Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Maybe Text -> Maybe Text -> m ()
menuAppend Menu
menuModel (Text -> Maybe Text
forall a. a -> Maybe a
Just "Copy") (Text -> Maybe Text
forall a. a -> Maybe a
Just "app.copy")
Menu -> Maybe Text -> Maybe Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Maybe Text -> Maybe Text -> m ()
menuAppend Menu
menuModel (Text -> Maybe Text
forall a. a -> Maybe a
Just "Paste") (Text -> Maybe Text
forall a. a -> Maybe a
Just "app.paste")
Menu -> Maybe Text -> Maybe Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Maybe Text -> Maybe Text -> m ()
menuAppend Menu
menuModel (Text -> Maybe Text
forall a. a -> Maybe a
Just "Preferences") (Text -> Maybe Text
forall a. a -> Maybe a
Just "app.preferences")
Menu
menu <- Menu -> IO Menu
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuModel a) =>
a -> m Menu
menuNewFromModel Menu
menuModel
Menu -> Terminal -> Maybe MenuDetachFunc -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsWidget b) =>
a -> b -> Maybe MenuDetachFunc -> m ()
menuAttachToWidget Menu
menu Terminal
vteTerm Maybe MenuDetachFunc
forall a. Maybe a
Nothing
Menu -> Maybe Event -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Maybe Event -> m ()
menuPopupAtPointer Menu
menu Maybe Event
forall a. Maybe a
Nothing
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
rightClick