    {-# 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'

    -- | Compute the text for a 'Label' for a GTK Notebook tab.
    --
    -- >>> computeTabLabel 0 (Just "me@machine:~")
    -- "1. me@machine:~"
    --
    -- >>> computeTabLabel 5 (Just "bash process")
    -- "6. bash process"
    --
    -- >>> computeTabLabel 2 Nothing
    -- "3. shell"
    computeTabLabel
      :: Int
      -- ^ Tab number.  0 is used for the first tab, 1 for the second, etc.
      -> Maybe Text
      -- ^ A possible title for a tab.  If this is 'Nothing', then the string
      -- @shell@ will be used.
      -> 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

    -- | Update the given 'Label' for a GTK Notebook tab.
    --
    -- The new text for the label is determined by the 'computeTabLabel' function.
    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

    -- | TODO: This should probably be implemented in an external package,
    -- since it is a generally useful utility.
    --
    -- It should also be implemented for windows and osx.
    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

    -- | Get the current working directory from the shell in the focused tab of a
    -- notebook.
    --
    -- Returns 'Nothing' if there is no focused tab of the notebook, or the
    -- current working directory could not be detected for the shell.
    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

    -- | Create the VTE 'Terminal', set the fonts and options
    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

    -- | Starts a shell in a terminal and return a new TMTerm
    launchShell
      :: Terminal
      -- ^ GTK 'Terminal' to spawn the shell in.
      -> Maybe Text
      -- ^ An optional path to the current working directory to start the
      -- shell in.  If 'Nothing', use the current working directory of the
      -- termonad process.
      -> IO Int
    launchShell :: Terminal -> Maybe Text -> IO Int
    launchShell vteTerm :: Terminal
    vteTerm maybeCurrDir :: Maybe Text
    maybeCurrDir = do
      -- Should probably use GI.Vte.Functions.getUserShell, but contrary to its
      -- documentation it raises an exception rather wrap in Maybe.
      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)
      -- Launch the shell
      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)

    -- | Add a page to the notebook and switch to it.
    addPage
      :: TMState
      -> TMNotebookTab
      -> Box
      -- ^ The GTK Object holding the label we want to show for the tab of the
      -- newly created page of the notebook.
      -> IO ()
    addPage :: TMState -> TMNotebookTab -> Box -> IO ()
    addPage mvarTMState :: TMState
    mvarTMState notebookTab :: TMNotebookTab
    notebookTab tabLabelBox :: Box
    tabLabelBox = do
      -- Append a new notebook page and update the TMState to reflect this.
      (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

      -- Switch the current Notebook page to the the newly added page.
      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))

    -- | Set the keyboard focus on a vte terminal
    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)

    -- | Create a new 'TMTerm', setting it up and adding it to the GTKNotebook.
    createTerm
      :: (TMState -> EventKey -> IO Bool)
      -- ^ Funtion for handling key presses on the terminal.
      -> TMState
      -> IO TMTerm
    createTerm :: (TMState -> EventKey -> IO Bool) -> TMState -> IO TMTerm
    createTerm handleKeyPress :: TMState -> EventKey -> IO Bool
    handleKeyPress mvarTMState :: TMState
    mvarTMState = do
      -- Check preconditions
      TMState -> IO ()
    assertInvariantTMState TMState
    mvarTMState

      -- Read needed data in TMVar
      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

      -- Create a new terminal and launch a shell in it
      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

      -- Create the container add the VTE term in it
      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

      -- Create the GTK widget for the Notebook tab
      (tabLabelBox :: Box
    tabLabelBox, tabLabel :: Label
    tabLabel, tabCloseButton :: Button
    tabCloseButton) <- IO (Box, Label, Button)
    createNotebookTabLabel

      -- Create notebook state
      let notebookTab :: TMNotebookTab
    notebookTab = Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
    createTMNotebookTab Label
    tabLabel ScrolledWindow
    scrolledWin TMTerm
    tmTerm

      -- Add the new notebooktab to the notebook.
      TMState -> TMNotebookTab -> Box -> IO ()
    addPage TMState
    mvarTMState TMNotebookTab
    notebookTab Box
    tabLabelBox

      -- Setup the initial label for the notebook tab.  This needs to happen
      -- after we add the new page to the notebook, so that the page can get labelled
      -- appropriately.
      Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
    relabelTab (TMNotebook -> Notebook
    tmNotebook TMNotebook
    currNote) Label
    tabLabel ScrolledWindow
    scrolledWin Terminal
    vteTerm

      -- Connect callbacks
      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

      -- Put the keyboard focus on the term
      ApplicationWindow -> Terminal -> IO ()
    setFocusOn ApplicationWindow
    tmStateAppWin Terminal
    vteTerm

      -- Make sure the state is still right
      TMState -> IO ()
    assertInvariantTMState TMState
    mvarTMState

      -- Run user-defined hooks for modifying the newly-created VTE Terminal.
      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

    -- | Popup the context menu on right click
    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
    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