{-# LANGUAGE CPP #-} -- | This module contains two things: -- -- 1. Extension functions to libraries like GTK. These functions wrap up some -- generic GTK functionality. They are not Termonad-specific. -- -- 2. Wrappers around functionality that is only specific to certain versions -- of libraries like GTK or VTE. -- -- For instance, 'terminalSetEnableSixelIfExists' is -- a wrapper around 'terminalSetEnableSixel'. Sixel support is only availble in -- vte >= 0.63, so if a user tries to compile Termonad with a version of vte -- less than 0.63, this function won't do anything. module Termonad.Gtk where import Termonad.Prelude import Control.Monad.Fail (MonadFail, fail) import Data.GI.Base (ManagedPtr, withManagedPtr) import GHC.Stack (HasCallStack) import GI.Gdk ( GObject , castTo ) import GI.Gio (ApplicationFlags) import GI.Gtk (Application, IsWidget, Widget(Widget), applicationNew, builderGetObject, toWidget) import qualified GI.Gtk as Gtk import GI.Vte ( IsTerminal #ifdef VTE_VERSION_GEQ_0_63 , terminalSetEnableSixel #endif ) objFromBuildUnsafe :: GObject o => Gtk.Builder -> Text -> (ManagedPtr o -> o) -> IO o objFromBuildUnsafe builder name constructor = do maybePlainObj <- builderGetObject builder name case maybePlainObj of Nothing -> error $ "Couldn't get " <> unpack name <> " from builder!" Just plainObj -> do maybeNewObj <- castTo constructor plainObj case maybeNewObj of Nothing -> error $ "Got " <> unpack name <> " from builder, but couldn't convert to object!" Just obj -> pure obj -- | Unsafely creates a new 'Application'. This calls 'fail' if it cannot -- create the 'Application' for some reason. -- -- This can fail for different reasons, one of which being that application -- name does not have a period in it. appNew :: (HasCallStack, MonadIO m, MonadFail m) => Maybe Text -- ^ The application name. Must have a period in it if specified. If passed -- as 'Nothing', then no application name will be used. -> [ApplicationFlags] -> m Application appNew appName appFlags = do maybeApp <- applicationNew appName appFlags case maybeApp of Nothing -> fail "Could not create application for some reason!" Just app -> pure app -- | Tests to see if two GTK widgets point to the same thing. This should only -- happen if they are actually the same thing. widgetEq :: (MonadIO m, IsWidget a, IsWidget b) => a -> b -> m Bool widgetEq a b = do Widget managedPtrA <- toWidget a Widget managedPtrB <- toWidget b liftIO $ withManagedPtr managedPtrA $ \ptrA -> withManagedPtr managedPtrB $ \ptrB -> pure (ptrA == ptrB) -- | Wrapper around 'terminalSetEnableSixel'. The 'terminalSetEnableSixel' function -- is only available starting with vte-0.63. This function has no effect when -- compiling against previous versions of vte. terminalSetEnableSixelIfExists :: (HasCallStack, MonadIO m, IsTerminal t) => t -- ^ a Terminal -> Bool -- ^ whether to enable SIXEL images -> m () terminalSetEnableSixelIfExists t b = do #ifdef VTE_VERSION_GEQ_0_63 terminalSetEnableSixel t b #endif pure ()