module Termonad.App where
import Termonad.Prelude
import Config.Dyre (defaultParams, projectName, realMain, showError, wrapMain)
import Control.Lens ((.~), (^.), (^..), over, set, view)
import Control.Monad.Fail (fail)
import Data.FocusList (focusList, moveFromToFL, updateFocusFL)
import Data.Sequence (findIndexR)
import GI.Gdk (castTo, managedForeignPtr, screenGetDefault)
import GI.Gio
( ApplicationFlags(ApplicationFlagsFlagsNone)
, MenuModel(MenuModel)
, actionMapAddAction
, applicationQuit
, applicationRun
, onApplicationActivate
, onApplicationStartup
, onSimpleActionActivate
, simpleActionNew
)
import GI.Gtk
( Application
, ApplicationWindow(ApplicationWindow)
, Box(Box)
, CheckButton(CheckButton)
, ComboBoxText(ComboBoxText)
, Dialog(Dialog)
, Entry(Entry)
, FontButton(FontButton)
, Label(Label)
, PolicyType(PolicyTypeAutomatic)
, PositionType(PositionTypeRight)
, ResponseType(ResponseTypeAccept, ResponseTypeNo, ResponseTypeYes)
, ScrolledWindow(ScrolledWindow)
, SpinButton(SpinButton)
, pattern STYLE_PROVIDER_PRIORITY_APPLICATION
, aboutDialogNew
, adjustmentNew
, applicationAddWindow
, applicationGetActiveWindow
, applicationSetAccelsForAction
, applicationSetMenubar
, applicationWindowSetShowMenubar
, boxPackStart
, builderNewFromString
, builderSetApplication
, comboBoxGetActiveId
, comboBoxSetActiveId
, comboBoxTextAppend
, containerAdd
, cssProviderLoadFromData
, cssProviderNew
, dialogAddButton
, dialogGetContentArea
, dialogNew
, dialogResponse
, dialogRun
, entryBufferGetText
, entryBufferSetText
, entryGetText
, entryNew
, fontChooserSetFontDesc
, fontChooserGetFontDesc
, getEntryBuffer
, gridAttachNextTo
, gridNew
, labelNew
, notebookGetNPages
, notebookNew
, notebookSetShowBorder
, onEntryActivate
, onNotebookPageRemoved
, onNotebookPageReordered
, onNotebookSwitchPage
, onWidgetDeleteEvent
, scrolledWindowSetPolicy
, setWidgetMargin
, spinButtonGetValueAsInt
, spinButtonSetAdjustment
, spinButtonSetValue
, styleContextAddProviderForScreen
, toggleButtonGetActive
, toggleButtonSetActive
, widgetDestroy
, widgetGrabFocus
, widgetSetCanFocus
, widgetSetVisible
, widgetShow
, widgetShowAll
, windowPresent
, windowSetDefaultIconFromFile
, windowSetTitle
, windowSetTransientFor
)
import qualified GI.Gtk as Gtk
import GI.Pango
( FontDescription
, pattern SCALE
, fontDescriptionGetFamily
, fontDescriptionGetSize
, fontDescriptionGetSizeIsAbsolute
, fontDescriptionNew
, fontDescriptionSetFamily
, fontDescriptionSetSize
, fontDescriptionSetAbsoluteSize
)
import GI.Vte
( CursorBlinkMode(..)
, catchRegexError
, regexNewForSearch
, terminalCopyClipboard
, terminalPasteClipboard
, terminalSearchFindNext
, terminalSearchFindPrevious
, terminalSearchSetRegex
, terminalSearchSetWrapAround
, terminalSetBoldIsBright
, terminalSetCursorBlinkMode
, terminalSetFont
, terminalSetScrollbackLines
, terminalSetWordCharExceptions
, terminalSetAllowBold
)
import System.Environment (getExecutablePath)
import System.FilePath (takeFileName)
import Paths_termonad (getDataFileName)
import Termonad.Gtk (appNew, objFromBuildUnsafe, terminalSetEnableSixelIfExists)
import Termonad.Keys (handleKeyPress)
import Termonad.Lenses
( lensBoldIsBright
, lensEnableSixel
, lensAllowBold
, lensConfirmExit
, lensCursorBlinkMode
, lensFontConfig
, lensOptions
, lensShowMenu
, lensShowScrollbar
, lensShowTabBar
, lensScrollbackLen
, lensTMNotebook
, lensTMNotebookTabTermContainer
, lensTMNotebookTabs
, lensTMNotebookTabTerm
, lensTMStateApp
, lensTMStateAppWin
, lensTMStateConfig
, lensTMStateFontDesc
, lensTMStateNotebook
, lensTerm
, lensWordCharExceptions
)
import Termonad.PreferencesFile (saveToPreferencesFile)
import Termonad.Term
( createTerm
, relabelTabs
, termNextPage
, termPrevPage
, termExitFocused
, setShowTabs
, showScrollbarToPolicy
)
import Termonad.Types
( ConfigOptions(..)
, FontConfig(..)
, FontSize(FontSizePoints, FontSizeUnits)
, ShowScrollbar(..)
, ShowTabBar(..)
, TMConfig
, TMNotebookTab
, TMState
, TMState'(TMState)
, getFocusedTermFromState
, modFontSize
, newEmptyTMState
, tmNotebookTabTermContainer
, tmNotebookTabs
, tmStateApp
, tmStateNotebook
)
import Termonad.XML (interfaceText, menuText, preferencesText)
setupScreenStyle :: IO ()
setupScreenStyle :: IO ()
setupScreenStyle = do
Maybe Screen
maybeScreen <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m (Maybe Screen)
screenGetDefault
case Maybe Screen
maybeScreen of
Maybe Screen
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Screen
screen -> do
CssProvider
cssProvider <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m CssProvider
cssProviderNew
let ([Text]
textLines :: [Text]) =
[
Text
"scrollbar {"
, Text
" background-color: #aaaaaa;"
, Text
"}"
, Text
"tab {"
, Text
" background-color: transparent;"
, Text
"}"
]
let styleData :: ByteString
styleData = forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 (forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines [Text]
textLines :: Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCssProvider a) =>
a -> ByteString -> m ()
cssProviderLoadFromData CssProvider
cssProvider ByteString
styleData
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsScreen a, IsStyleProvider b) =>
a -> b -> Word32 -> m ()
styleContextAddProviderForScreen
Screen
screen
CssProvider
cssProvider
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
STYLE_PROVIDER_PRIORITY_APPLICATION)
createFontDescFromConfig :: TMConfig -> IO FontDescription
createFontDescFromConfig :: TMConfig -> IO FontDescription
createFontDescFromConfig TMConfig
tmConfig = do
let fontConf :: FontConfig
fontConf = TMConfig
tmConfig forall s a. s -> Getting a s a -> a
^. Lens' TMConfig ConfigOptions
lensOptions forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' ConfigOptions FontConfig
lensFontConfig
FontSize -> Text -> IO FontDescription
createFontDesc (FontConfig -> FontSize
fontSize FontConfig
fontConf) (FontConfig -> Text
fontFamily FontConfig
fontConf)
createFontDesc :: FontSize -> Text -> IO FontDescription
createFontDesc :: FontSize -> Text -> IO FontDescription
createFontDesc FontSize
fontSz Text
fontFam = do
FontDescription
fontDesc <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m FontDescription
fontDescriptionNew
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> Text -> m ()
fontDescriptionSetFamily FontDescription
fontDesc Text
fontFam
FontDescription -> FontSize -> IO ()
setFontDescSize FontDescription
fontDesc FontSize
fontSz
forall (f :: * -> *) a. Applicative f => a -> f a
pure FontDescription
fontDesc
setFontDescSize :: FontDescription -> FontSize -> IO ()
setFontDescSize :: FontDescription -> FontSize -> IO ()
setFontDescSize FontDescription
fontDesc (FontSizePoints Int
points) =
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> Int32 -> m ()
fontDescriptionSetSize FontDescription
fontDesc forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
points forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE)
setFontDescSize FontDescription
fontDesc (FontSizeUnits Double
units) =
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> Double -> m ()
fontDescriptionSetAbsoluteSize FontDescription
fontDesc forall a b. (a -> b) -> a -> b
$ Double
units forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE
adjustFontDescSize :: (FontSize -> FontSize) -> FontDescription -> IO ()
adjustFontDescSize :: (FontSize -> FontSize) -> FontDescription -> IO ()
adjustFontDescSize FontSize -> FontSize
f FontDescription
fontDesc = do
FontSize
currFontSz <- FontDescription -> IO FontSize
fontSizeFromFontDescription FontDescription
fontDesc
let newFontSz :: FontSize
newFontSz = FontSize -> FontSize
f FontSize
currFontSz
FontDescription -> FontSize -> IO ()
setFontDescSize FontDescription
fontDesc FontSize
newFontSz
modifyFontSizeForAllTerms :: (FontSize -> FontSize) -> TMState -> IO ()
modifyFontSizeForAllTerms :: (FontSize -> FontSize) -> TMState -> IO ()
modifyFontSizeForAllTerms FontSize -> FontSize
modFontSizeFunc TMState
mvarTMState = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let fontDesc :: FontDescription
fontDesc = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' FontDescription
lensTMStateFontDesc
(FontSize -> FontSize) -> FontDescription -> IO ()
adjustFontDescSize FontSize -> FontSize
modFontSizeFunc FontDescription
fontDesc
let terms :: [Terminal]
terms =
TMState'
tmState forall s a. s -> Getting (Endo [a]) s a -> [a]
^..
Lens' TMState' TMNotebook
lensTMStateNotebook forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Lens' TMNotebookTab TMTerm
lensTMNotebookTabTerm forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Lens' TMTerm Terminal
lensTerm
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
foldMap (\Element [Terminal]
vteTerm -> forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe FontDescription -> m ()
terminalSetFont Element [Terminal]
vteTerm (forall a. a -> Maybe a
Just FontDescription
fontDesc)) [Terminal]
terms
fontSizeFromFontDescription :: FontDescription -> IO FontSize
fontSizeFromFontDescription :: FontDescription -> IO FontSize
fontSizeFromFontDescription FontDescription
fontDesc = do
Int32
currSize <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m Int32
fontDescriptionGetSize FontDescription
fontDesc
Bool
currAbsolute <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m Bool
fontDescriptionGetSizeIsAbsolute FontDescription
fontDesc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
currAbsolute
then Double -> FontSize
FontSizeUnits forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
currSize forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE
else
let Double
fontRatio :: Double = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
currSize forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE
in Int -> FontSize
FontSizePoints forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round Double
fontRatio
fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)
fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)
fontConfigFromFontDescription FontDescription
fontDescription = do
FontSize
fontSize <- FontDescription -> IO FontSize
fontSizeFromFontDescription FontDescription
fontDescription
Maybe Text
maybeFontFamily <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m (Maybe Text)
fontDescriptionGetFamily FontDescription
fontDescription
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text -> FontSize -> FontConfig
`FontConfig` FontSize
fontSize) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
maybeFontFamily
compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool
compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool
compareScrolledWinAndTab ScrolledWindow
scrollWin TMNotebookTab
flTab =
let ScrolledWindow ManagedPtr ScrolledWindow
managedPtrFLTab = TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer TMNotebookTab
flTab
foreignPtrFLTab :: ForeignPtr ScrolledWindow
foreignPtrFLTab = forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr ScrolledWindow
managedPtrFLTab
ScrolledWindow ManagedPtr ScrolledWindow
managedPtrScrollWin = ScrolledWindow
scrollWin
foreignPtrScrollWin :: ForeignPtr ScrolledWindow
foreignPtrScrollWin = forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr ManagedPtr ScrolledWindow
managedPtrScrollWin
in ForeignPtr ScrolledWindow
foreignPtrFLTab forall a. Eq a => a -> a -> Bool
== ForeignPtr ScrolledWindow
foreignPtrScrollWin
updateFLTabPos :: TMState -> Int -> Int -> IO ()
updateFLTabPos :: TMState -> Int -> Int -> IO ()
updateFLTabPos TMState
mvarTMState Int
oldPos Int
newPos =
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ TMState
mvarTMState forall a b. (a -> b) -> a -> b
$ \TMState'
tmState -> do
let tabs :: FocusList TMNotebookTab
tabs = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMNotebook
lensTMStateNotebook forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs
maybeNewTabs :: Maybe (FocusList TMNotebookTab)
maybeNewTabs = forall a.
Show a =>
Int -> Int -> FocusList a -> Maybe (FocusList a)
moveFromToFL Int
oldPos Int
newPos FocusList TMNotebookTab
tabs
case Maybe (FocusList TMNotebookTab)
maybeNewTabs of
Maybe (FocusList TMNotebookTab)
Nothing -> do
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$
Text
"in updateFLTabPos, Strange error: couldn't move tabs.\n" forall a. Semigroup a => a -> a -> a
<>
Text
"old pos: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
oldPos forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
Text
"new pos: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
newPos forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
Text
"tabs: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow FocusList TMNotebookTab
tabs forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
Text
"maybeNewTabs: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Maybe (FocusList TMNotebookTab)
maybeNewTabs forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
Text
"tmState: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow TMState'
tmState
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMState'
tmState
Just FocusList TMNotebookTab
newTabs ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
TMState'
tmState forall a b. a -> (a -> b) -> b
&
Lens' TMState' TMNotebook
lensTMStateNotebook forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs forall s t a b. ASetter s t a b -> b -> s -> t
.~ FocusList TMNotebookTab
newTabs
askShouldExit :: TMState -> IO ResponseType
askShouldExit :: TMState -> IO ResponseType
askShouldExit TMState
mvarTMState = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let confirm :: Bool
confirm = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMConfig
lensTMStateConfig forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMConfig ConfigOptions
lensOptions forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' ConfigOptions Bool
lensConfirmExit
if Bool
confirm
then TMState' -> IO ResponseType
confirmationDialogForExit TMState'
tmState
else forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseType
ResponseTypeYes
where
confirmationDialogForExit :: TMState' -> IO ResponseType
confirmationDialogForExit :: TMState' -> IO ResponseType
confirmationDialogForExit TMState'
tmState = do
let app :: Application
app = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' Application
lensTMStateApp
Maybe Window
win <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
Dialog
dialog <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m Dialog
dialogNew
Box
box <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Box
dialogGetContentArea Dialog
dialog
Label
label <-
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
labelNew forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just
Text
"There are still terminals running. Are you sure you want to exit?"
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Box
box Label
label
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Label
label
forall (m :: * -> *) o.
(MonadIO m, IsWidget o) =>
o -> Int32 -> m ()
setWidgetMargin Label
label Int32
10
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Text -> Int32 -> m Widget
dialogAddButton
Dialog
dialog
Text
"No, do NOT exit"
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeNo))
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Text -> Int32 -> m Widget
dialogAddButton
Dialog
dialog
Text
"Yes, exit"
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeYes))
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWindow b) =>
a -> Maybe b -> m ()
windowSetTransientFor Dialog
dialog Maybe Window
win
Int32
res <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun Dialog
dialog
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy Dialog
dialog
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
res)
forceQuit :: TMState -> IO ()
forceQuit :: TMState -> IO ()
forceQuit TMState
mvarTMState = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let app :: Application
app = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' Application
lensTMStateApp
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m ()
applicationQuit Application
app
setupTermonad :: TMConfig -> Application -> ApplicationWindow -> Gtk.Builder -> IO ()
setupTermonad :: TMConfig -> Application -> ApplicationWindow -> Builder -> IO ()
setupTermonad TMConfig
tmConfig Application
app ApplicationWindow
win Builder
builder = do
FilePath
termonadIconPath <- FilePath -> IO FilePath
getDataFileName FilePath
"img/termonad-lambda.png"
forall (m :: * -> *). (HasCallStack, MonadIO m) => FilePath -> m ()
windowSetDefaultIconFromFile FilePath
termonadIconPath
IO ()
setupScreenStyle
Box
box <- forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
builder Text
"content_box" ManagedPtr Box -> Box
Box
FontDescription
fontDesc <- TMConfig -> IO FontDescription
createFontDescFromConfig TMConfig
tmConfig
Notebook
note <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m Notebook
notebookNew
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetCanFocus Notebook
note Bool
False
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Bool -> m ()
notebookSetShowBorder Notebook
note Bool
False
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Bool -> Bool -> Word32 -> m ()
boxPackStart Box
box Notebook
note Bool
True Bool
True Word32
0
TMState
mvarTMState <- TMConfig
-> Application
-> ApplicationWindow
-> Notebook
-> FontDescription
-> IO TMState
newEmptyTMState TMConfig
tmConfig Application
app ApplicationWindow
win Notebook
note FontDescription
fontDesc
TMTerm
terminal <- (TMState -> EventKey -> IO Bool) -> TMState -> IO TMTerm
createTerm TMState -> EventKey -> IO Bool
handleKeyPress TMState
mvarTMState
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsNotebook a, MonadIO m) =>
a
-> ((?self::a) => NotebookPageRemovedCallback) -> m SignalHandlerId
onNotebookPageRemoved Notebook
note forall a b. (a -> b) -> a -> b
$ \Widget
_ Word32
_ -> do
Int32
pages <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> m Int32
notebookGetNPages Notebook
note
if Int32
pages forall a. Eq a => a -> a -> Bool
== Int32
0
then TMState -> IO ()
forceQuit TMState
mvarTMState
else TMConfig -> Notebook -> IO ()
setShowTabs TMConfig
tmConfig Notebook
note
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsNotebook a, MonadIO m) =>
a
-> ((?self::a) => NotebookPageRemovedCallback) -> m SignalHandlerId
onNotebookSwitchPage Notebook
note forall a b. (a -> b) -> a -> b
$ \Widget
_ Word32
pageNum -> do
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ TMState
mvarTMState forall a b. (a -> b) -> a -> b
$ \TMState'
tmState -> do
let notebook :: TMNotebook
notebook = TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
tabs :: FocusList TMNotebookTab
tabs = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
notebook
maybeNewTabs :: Maybe (TMNotebookTab, FocusList TMNotebookTab)
maybeNewTabs = forall a. Int -> FocusList a -> Maybe (a, FocusList a)
updateFocusFL (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pageNum) FocusList TMNotebookTab
tabs
case Maybe (TMNotebookTab, FocusList TMNotebookTab)
maybeNewTabs of
Maybe (TMNotebookTab, FocusList TMNotebookTab)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TMState'
tmState
Just (TMNotebookTab
tab, FocusList TMNotebookTab
newTabs) -> do
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetGrabFocus forall a b. (a -> b) -> a -> b
$ TMNotebookTab
tab forall s a. s -> Getting a s a -> a
^. Lens' TMNotebookTab TMTerm
lensTMNotebookTabTerm forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMTerm Terminal
lensTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
TMState'
tmState forall a b. a -> (a -> b) -> b
&
Lens' TMState' TMNotebook
lensTMStateNotebook forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs forall s t a b. ASetter s t a b -> b -> s -> t
.~ FocusList TMNotebookTab
newTabs
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsNotebook a, MonadIO m) =>
a
-> ((?self::a) => NotebookPageRemovedCallback) -> m SignalHandlerId
onNotebookPageReordered Notebook
note forall a b. (a -> b) -> a -> b
$ \Widget
childWidg Word32
pageNum -> do
Maybe ScrolledWindow
maybeScrollWin <- forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o', GObject o') =>
(ManagedPtr o' -> o') -> o -> IO (Maybe o')
castTo ManagedPtr ScrolledWindow -> ScrolledWindow
ScrolledWindow Widget
childWidg
case Maybe ScrolledWindow
maybeScrollWin of
Maybe ScrolledWindow
Nothing ->
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
FilePath
"In setupTermonad, in callback for onNotebookPageReordered, " forall a. Semigroup a => a -> a -> a
<>
FilePath
"child widget is not a ScrolledWindow.\n" forall a. Semigroup a => a -> a -> a
<>
FilePath
"Don't know how to continue.\n"
Just ScrolledWindow
scrollWin -> do
TMState{TMNotebook
tmStateNotebook :: TMNotebook
tmStateNotebook :: TMState' -> TMNotebook
tmStateNotebook} <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let fl :: FocusList TMNotebookTab
fl = TMNotebook
tmStateNotebook forall s a. s -> Getting a s a -> a
^. Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs
let maybeOldPosition :: Maybe Int
maybeOldPosition =
forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexR (ScrolledWindow -> TMNotebookTab -> Bool
compareScrolledWinAndTab ScrolledWindow
scrollWin) (forall a. FocusList a -> Seq a
focusList FocusList TMNotebookTab
fl)
case Maybe Int
maybeOldPosition of
Maybe Int
Nothing ->
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
FilePath
"In setupTermonad, in callback for onNotebookPageReordered, " forall a. Semigroup a => a -> a -> a
<>
FilePath
"the ScrolledWindow is not already in the FocusList.\n" forall a. Semigroup a => a -> a -> a
<>
FilePath
"Don't know how to continue.\n"
Just Int
oldPos -> do
TMState -> Int -> Int -> IO ()
updateFLTabPos TMState
mvarTMState Int
oldPos (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pageNum)
TMState -> IO ()
relabelTabs TMState
mvarTMState
SimpleAction
newTabAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"newtab" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
newTabAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ (TMState -> EventKey -> IO Bool) -> TMState -> IO TMTerm
createTerm TMState -> EventKey -> IO Bool
handleKeyPress TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
newTabAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.newtab" [Text
"<Shift><Ctrl>T"]
SimpleAction
nextPageAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"nextpage" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
nextPageAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ ->
TMState -> IO ()
termNextPage TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
nextPageAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.nextpage" [Text
"<Ctrl>Page_Down"]
SimpleAction
prevPageAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"prevpage" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
prevPageAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ ->
TMState -> IO ()
termPrevPage TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
prevPageAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.prevpage" [Text
"<Ctrl>Page_Up"]
SimpleAction
closeTabAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"closetab" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
closeTabAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ ->
TMState -> IO ()
termExitFocused TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
closeTabAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.closetab" [Text
"<Shift><Ctrl>W"]
SimpleAction
quitAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"quit" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
quitAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> do
ResponseType
shouldExit <- TMState -> IO ResponseType
askShouldExit TMState
mvarTMState
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ResponseType
shouldExit forall a. Eq a => a -> a -> Bool
== ResponseType
ResponseTypeYes) forall a b. (a -> b) -> a -> b
$ TMState -> IO ()
forceQuit TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
quitAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.quit" [Text
"<Shift><Ctrl>Q"]
SimpleAction
copyAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"copy" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
copyAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> do
Maybe Terminal
maybeTerm <- TMState -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> m ()
terminalCopyClipboard Maybe Terminal
maybeTerm
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
copyAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.copy" [Text
"<Shift><Ctrl>C"]
SimpleAction
pasteAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"paste" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
pasteAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> do
Maybe Terminal
maybeTerm <- TMState -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> m ()
terminalPasteClipboard Maybe Terminal
maybeTerm
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
pasteAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.paste" [Text
"<Shift><Ctrl>V"]
SimpleAction
preferencesAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"preferences" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
preferencesAction (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ TMState -> IO ()
showPreferencesDialog TMState
mvarTMState)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
preferencesAction
SimpleAction
enlargeFontAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"enlargefont" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
enlargeFontAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ ->
(FontSize -> FontSize) -> TMState -> IO ()
modifyFontSizeForAllTerms (Int -> FontSize -> FontSize
modFontSize Int
1) TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
enlargeFontAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.enlargefont" [Text
"<Ctrl>plus"]
SimpleAction
reduceFontAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"reducefont" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
reduceFontAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ ->
(FontSize -> FontSize) -> TMState -> IO ()
modifyFontSizeForAllTerms (Int -> FontSize -> FontSize
modFontSize (-Int
1)) TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
reduceFontAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.reducefont" [Text
"<Ctrl>minus"]
SimpleAction
findAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"find" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
findAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> TMState -> IO ()
doFind TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
findAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.find" [Text
"<Shift><Ctrl>F"]
SimpleAction
findAboveAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"findabove" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
findAboveAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> TMState -> IO ()
findAbove TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
findAboveAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.findabove" [Text
"<Shift><Ctrl>P"]
SimpleAction
findBelowAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"findbelow" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
findBelowAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> TMState -> IO ()
findBelow TMState
mvarTMState
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
findBelowAction
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Text -> [Text] -> m ()
applicationSetAccelsForAction Application
app Text
"app.findbelow" [Text
"<Shift><Ctrl>I"]
SimpleAction
aboutAction <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe VariantType -> m SimpleAction
simpleActionNew Text
"about" forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsSimpleAction a, MonadIO m) =>
a
-> ((?self::a) => SimpleActionActivateCallback)
-> m SignalHandlerId
onSimpleActionActivate SimpleAction
aboutAction forall a b. (a -> b) -> a -> b
$ \Maybe GVariant
_ -> Application -> IO ()
showAboutDialog Application
app
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActionMap a, IsAction b) =>
a -> b -> m ()
actionMapAddAction Application
app SimpleAction
aboutAction
Builder
menuBuilder <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> m Builder
builderNewFromString Text
menuText forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall mono. MonoFoldable mono => mono -> Int
length Text
menuText)
MenuModel
menuModel <- forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
menuBuilder Text
"menubar" ManagedPtr MenuModel -> MenuModel
MenuModel
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsApplication a, IsMenuModel b) =>
a -> Maybe b -> m ()
applicationSetMenubar Application
app (forall a. a -> Maybe a
Just MenuModel
menuModel)
let showMenu :: Bool
showMenu = TMConfig
tmConfig forall s a. s -> Getting a s a -> a
^. Lens' TMConfig ConfigOptions
lensOptions forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' ConfigOptions Bool
lensShowMenu
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationWindow a) =>
a -> Bool -> m ()
applicationWindowSetShowMenubar ApplicationWindow
win Bool
showMenu
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWindow a) =>
a -> Text -> m ()
windowSetTitle ApplicationWindow
win Text
"Termonad"
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => WidgetDeleteEventCallback) -> m SignalHandlerId
onWidgetDeleteEvent ApplicationWindow
win forall a b. (a -> b) -> a -> b
$ \Event
_ -> do
ResponseType
shouldExit <- TMState -> IO ResponseType
askShouldExit TMState
mvarTMState
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
case ResponseType
shouldExit of
ResponseType
ResponseTypeYes -> Bool
False
ResponseType
_ -> Bool
True
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShowAll ApplicationWindow
win
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetGrabFocus forall a b. (a -> b) -> a -> b
$ TMTerm
terminal forall s a. s -> Getting a s a -> a
^. Lens' TMTerm Terminal
lensTerm
appActivate :: TMConfig -> Application -> IO ()
appActivate :: TMConfig -> Application -> IO ()
appActivate TMConfig
tmConfig Application
app = do
Builder
uiBuilder <-
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> m Builder
builderNewFromString Text
interfaceText forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall mono. MonoFoldable mono => mono -> Int
length Text
interfaceText)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBuilder a, IsApplication b) =>
a -> b -> m ()
builderSetApplication Builder
uiBuilder Application
app
ApplicationWindow
appWin <- forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
uiBuilder Text
"appWin" ManagedPtr ApplicationWindow -> ApplicationWindow
ApplicationWindow
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsApplication a, IsWindow b) =>
a -> b -> m ()
applicationAddWindow Application
app ApplicationWindow
appWin
TMConfig -> Application -> ApplicationWindow -> Builder -> IO ()
setupTermonad TMConfig
tmConfig Application
app ApplicationWindow
appWin Builder
uiBuilder
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWindow a) =>
a -> m ()
windowPresent ApplicationWindow
appWin
showAboutDialog :: Application -> IO ()
showAboutDialog :: Application -> IO ()
showAboutDialog Application
app = do
Maybe Window
win <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
AboutDialog
aboutDialog <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m AboutDialog
aboutDialogNew
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWindow b) =>
a -> Maybe b -> m ()
windowSetTransientFor AboutDialog
aboutDialog Maybe Window
win
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun AboutDialog
aboutDialog
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy AboutDialog
aboutDialog
showFindDialog :: Application -> IO (Maybe Text)
showFindDialog :: Application -> IO (Maybe Text)
showFindDialog Application
app = do
Maybe Window
win <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
Dialog
dialog <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m Dialog
dialogNew
Box
box <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Box
dialogGetContentArea Dialog
dialog
Grid
grid <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m Grid
gridNew
Label
searchForLabel <- forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
labelNew (forall a. a -> Maybe a
Just Text
"Search for regex:")
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Grid
grid Label
searchForLabel
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Label
searchForLabel
forall (m :: * -> *) o.
(MonadIO m, IsWidget o) =>
o -> Int32 -> m ()
setWidgetMargin Label
searchForLabel Int32
10
Entry
searchEntry <- forall (m :: * -> *). (HasCallStack, MonadIO m) => m Entry
entryNew
forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsGrid a, IsWidget b, IsWidget c) =>
a -> b -> Maybe c -> PositionType -> Int32 -> Int32 -> m ()
gridAttachNextTo Grid
grid Entry
searchEntry (forall a. a -> Maybe a
Just Label
searchForLabel) PositionType
PositionTypeRight Int32
1 Int32
1
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Entry
searchEntry
forall (m :: * -> *) o.
(MonadIO m, IsWidget o) =>
o -> Int32 -> m ()
setWidgetMargin Entry
searchEntry Int32
10
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall a (m :: * -> *).
(IsEntry a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onEntryActivate Entry
searchEntry forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Int32 -> m ()
dialogResponse Dialog
dialog (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeYes))
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Text -> Int32 -> m Widget
dialogAddButton
Dialog
dialog
Text
"Close"
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeNo))
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> Text -> Int32 -> m Widget
dialogAddButton
Dialog
dialog
Text
"Find"
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ResponseType
ResponseTypeYes))
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Box
box Grid
grid
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShow Grid
grid
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWindow b) =>
a -> Maybe b -> m ()
windowSetTransientFor Dialog
dialog Maybe Window
win
Int32
res <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun Dialog
dialog
Text
searchString <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntry a) =>
a -> m Text
entryGetText Entry
searchEntry
let maybeSearchString :: Maybe Text
maybeSearchString =
case forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
res) of
ResponseType
ResponseTypeYes -> forall a. a -> Maybe a
Just Text
searchString
ResponseType
_ -> forall a. Maybe a
Nothing
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy Dialog
dialog
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
maybeSearchString
doFind :: TMState -> IO ()
doFind :: TMState -> IO ()
doFind TMState
mvarTMState = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let app :: Application
app = TMState' -> Application
tmStateApp TMState'
tmState
Maybe Text
maybeSearchString <- Application -> IO (Maybe Text)
showFindDialog Application
app
Maybe Terminal
maybeTerminal <- TMState -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState
case (Maybe Text
maybeSearchString, Maybe Terminal
maybeTerminal) of
(Just Text
searchString, Just Terminal
terminal) -> do
let pcreFlags :: Word32
pcreFlags = Word32
0
let newRegex :: IO Regex
newRegex =
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> Word32 -> m Regex
regexNewForSearch
Text
searchString
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall mono. MonoFoldable mono => mono -> Int
length Text
searchString)
Word32
pcreFlags
Either Text Regex
eitherRegex <-
forall a. IO a -> (RegexError -> Text -> IO a) -> IO a
catchRegexError
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right IO Regex
newRegex)
(\RegexError
_ Text
errMsg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Text
errMsg))
case Either Text Regex
eitherRegex of
Left Text
errMsg -> do
let msg :: Text
msg = Text
"error when creating regex: " forall a. Semigroup a => a -> a -> a
<> Text
errMsg
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
hPutStrLn Handle
stderr Text
msg
Right Regex
regex -> do
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe Regex -> Word32 -> m ()
terminalSearchSetRegex Terminal
terminal (forall a. a -> Maybe a
Just Regex
regex) Word32
pcreFlags
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSearchSetWrapAround Terminal
terminal Bool
True
Bool
_matchFound <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> m Bool
terminalSearchFindPrevious Terminal
terminal
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Maybe Text, Maybe Terminal)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
findAbove :: TMState -> IO ()
findAbove :: TMState -> IO ()
findAbove TMState
mvarTMState = do
Maybe Terminal
maybeTerminal <- TMState -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState
case Maybe Terminal
maybeTerminal of
Maybe Terminal
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Terminal
terminal -> do
Bool
_matchFound <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> m Bool
terminalSearchFindPrevious Terminal
terminal
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
findBelow :: TMState -> IO ()
findBelow :: TMState -> IO ()
findBelow TMState
mvarTMState = do
Maybe Terminal
maybeTerminal <- TMState -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState
case Maybe Terminal
maybeTerminal of
Maybe Terminal
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Terminal
terminal -> do
Bool
_matchFound <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> m Bool
terminalSearchFindNext Terminal
terminal
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
setShowMenuBar :: Application -> Bool -> IO ()
Application
app Bool
visible = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
Window
win <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
ApplicationWindow
appWin <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o', GObject o') =>
(ManagedPtr o' -> o') -> o -> IO (Maybe o')
castTo ManagedPtr ApplicationWindow -> ApplicationWindow
ApplicationWindow Window
win
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationWindow a) =>
a -> Bool -> m ()
applicationWindowSetShowMenubar ApplicationWindow
appWin Bool
visible
comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill ComboBoxText
comboBox = forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ (a, Text) -> IO ()
go
where
go :: (a, Text) -> IO ()
go :: (a, Text) -> IO ()
go (a
value, Text
textId) =
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBoxText a) =>
a -> Maybe Text -> Text -> m ()
comboBoxTextAppend ComboBoxText
comboBox (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow a
value) Text
textId
comboBoxSetActive :: Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive :: forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
cb a
item = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> Maybe Text -> m Bool
comboBoxSetActiveId ComboBoxText
cb (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow a
item)
comboBoxGetActive
:: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive :: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
cb [a]
values = Maybe Text -> Maybe a
findEnumFromMaybeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsComboBox a) =>
a -> m (Maybe Text)
comboBoxGetActiveId ComboBoxText
cb
where
findEnumFromMaybeId :: Maybe Text -> Maybe a
findEnumFromMaybeId :: Maybe Text -> Maybe a
findEnumFromMaybeId Maybe Text
maybeId = Maybe Text
maybeId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
findEnumFromId
findEnumFromId :: Text -> Maybe a
findEnumFromId :: Text -> Maybe a
findEnumFromId Text
label = forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find (\Element [a]
x -> forall a. Show a => a -> Text
tshow Element [a]
x forall a. Eq a => a -> a -> Bool
== Text
label) [a]
values
applyNewPreferences :: TMState -> IO ()
applyNewPreferences :: TMState -> IO ()
applyNewPreferences TMState
mvarTMState = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let appWin :: ApplicationWindow
appWin = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' ApplicationWindow
lensTMStateAppWin
config :: TMConfig
config = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMConfig
lensTMStateConfig
notebook :: Notebook
notebook = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMNotebook
lensTMStateNotebook forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMNotebook Notebook
lensTMNotebook
tabFocusList :: FocusList TMNotebookTab
tabFocusList = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMNotebook
lensTMStateNotebook forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMNotebook (FocusList TMNotebookTab)
lensTMNotebookTabs
showMenu :: Bool
showMenu = TMConfig
config forall s a. s -> Getting a s a -> a
^. Lens' TMConfig ConfigOptions
lensOptions forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' ConfigOptions Bool
lensShowMenu
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationWindow a) =>
a -> Bool -> m ()
applicationWindowSetShowMenubar ApplicationWindow
appWin Bool
showMenu
TMConfig -> Notebook -> IO ()
setShowTabs TMConfig
config Notebook
notebook
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
foldMap (TMState -> TMNotebookTab -> IO ()
applyNewPreferencesToTab TMState
mvarTMState) FocusList TMNotebookTab
tabFocusList
applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()
applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()
applyNewPreferencesToTab TMState
mvarTMState TMNotebookTab
tab = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let fontDesc :: FontDescription
fontDesc = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' FontDescription
lensTMStateFontDesc
term :: Terminal
term = TMNotebookTab
tab forall s a. s -> Getting a s a -> a
^. Lens' TMNotebookTab TMTerm
lensTMNotebookTabTerm forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMTerm Terminal
lensTerm
scrolledWin :: ScrolledWindow
scrolledWin = TMNotebookTab
tab forall s a. s -> Getting a s a -> a
^. Lens' TMNotebookTab ScrolledWindow
lensTMNotebookTabTermContainer
options :: ConfigOptions
options = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMConfig
lensTMStateConfig forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMConfig ConfigOptions
lensOptions
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Maybe FontDescription -> m ()
terminalSetFont Terminal
term (forall a. a -> Maybe a
Just FontDescription
fontDesc)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> CursorBlinkMode -> m ()
terminalSetCursorBlinkMode Terminal
term (ConfigOptions -> CursorBlinkMode
cursorBlinkMode ConfigOptions
options)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Text -> m ()
terminalSetWordCharExceptions Terminal
term (ConfigOptions -> Text
wordCharExceptions ConfigOptions
options)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> CLong -> m ()
terminalSetScrollbackLines Terminal
term (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConfigOptions -> Integer
scrollbackLen ConfigOptions
options))
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSetBoldIsBright Terminal
term (ConfigOptions -> Bool
boldIsBright ConfigOptions
options)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSetEnableSixelIfExists Terminal
term (ConfigOptions -> Bool
enableSixel ConfigOptions
options)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTerminal a) =>
a -> Bool -> m ()
terminalSetAllowBold Terminal
term (ConfigOptions -> Bool
allowBold ConfigOptions
options)
let vScrollbarPolicy :: PolicyType
vScrollbarPolicy = ShowScrollbar -> PolicyType
showScrollbarToPolicy (ConfigOptions
options forall s a. s -> Getting a s a -> a
^. Lens' ConfigOptions ShowScrollbar
lensShowScrollbar)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScrolledWindow a) =>
a -> PolicyType -> PolicyType -> m ()
scrolledWindowSetPolicy ScrolledWindow
scrolledWin PolicyType
PolicyTypeAutomatic PolicyType
vScrollbarPolicy
showPreferencesDialog :: TMState -> IO ()
showPreferencesDialog :: TMState -> IO ()
showPreferencesDialog TMState
mvarTMState = do
TMState'
tmState <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
let app :: Application
app = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' Application
lensTMStateApp
Builder
preferencesBuilder <-
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> m Builder
builderNewFromString Text
preferencesText forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall mono. MonoFoldable mono => mono -> Int
length Text
preferencesText)
Dialog
preferencesDialog <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"preferences" ManagedPtr Dialog -> Dialog
Dialog
CheckButton
confirmExitCheckButton <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"confirmExit" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
showMenuCheckButton <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"showMenu" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
boldIsBrightCheckButton <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"boldIsBright" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
enableSixelCheckButton <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"enableSixel" ManagedPtr CheckButton -> CheckButton
CheckButton
CheckButton
allowBoldCheckButton <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"allowBold" ManagedPtr CheckButton -> CheckButton
CheckButton
EntryBuffer
wordCharExceptionsEntryBuffer <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"wordCharExceptions" ManagedPtr Entry -> Entry
Entry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) o.
(MonadIO m, IsEntry o) =>
o -> m EntryBuffer
getEntryBuffer
FontButton
fontButton <- forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"font" ManagedPtr FontButton -> FontButton
FontButton
ComboBoxText
showScrollbarComboBoxText <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"showScrollbar" ManagedPtr ComboBoxText -> ComboBoxText
ComboBoxText
forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill
ComboBoxText
showScrollbarComboBoxText
[ (ShowScrollbar
ShowScrollbarNever, Text
"Never")
, (ShowScrollbar
ShowScrollbarAlways, Text
"Always")
, (ShowScrollbar
ShowScrollbarIfNeeded, Text
"If needed")
]
ComboBoxText
showTabBarComboBoxText <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"showTabBar" ManagedPtr ComboBoxText -> ComboBoxText
ComboBoxText
forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill
ComboBoxText
showTabBarComboBoxText
[ (ShowTabBar
ShowTabBarNever, Text
"Never")
, (ShowTabBar
ShowTabBarAlways, Text
"Always")
, (ShowTabBar
ShowTabBarIfNeeded, Text
"If needed")
]
ComboBoxText
cursorBlinkModeComboBoxText <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"cursorBlinkMode" ManagedPtr ComboBoxText -> ComboBoxText
ComboBoxText
forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
comboBoxFill
ComboBoxText
cursorBlinkModeComboBoxText
[ (CursorBlinkMode
CursorBlinkModeSystem, Text
"System")
, (CursorBlinkMode
CursorBlinkModeOn, Text
"On")
, (CursorBlinkMode
CursorBlinkModeOff, Text
"Off")
]
SpinButton
scrollbackLenSpinButton <-
forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"scrollbackLen" ManagedPtr SpinButton -> SpinButton
SpinButton
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double
-> Double -> Double -> Double -> Double -> Double -> m Adjustment
adjustmentNew Double
0 Double
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)) Double
1 Double
10 Double
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSpinButton a, IsAdjustment b) =>
a -> b -> m ()
spinButtonSetAdjustment SpinButton
scrollbackLenSpinButton
Label
warningLabel <- forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
preferencesBuilder Text
"warning" ManagedPtr Label -> Label
Label
FilePath
executablePath <- IO FilePath
getExecutablePath
let hasTermonadHs :: Bool
hasTermonadHs = FilePath -> FilePath
takeFileName FilePath
executablePath forall a. Eq a => a -> a -> Bool
== FilePath
"termonad-linux-x86_64"
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Bool -> m ()
widgetSetVisible Label
warningLabel Bool
hasTermonadHs
Maybe Window
maybeWin <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m (Maybe Window)
applicationGetActiveWindow Application
app
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWindow a, IsWindow b) =>
a -> Maybe b -> m ()
windowSetTransientFor Dialog
preferencesDialog Maybe Window
maybeWin
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontChooser a) =>
a -> FontDescription -> m ()
fontChooserSetFontDesc FontButton
fontButton (TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' FontDescription
lensTMStateFontDesc)
let options :: ConfigOptions
options = TMState'
tmState forall s a. s -> Getting a s a -> a
^. Lens' TMState' TMConfig
lensTMStateConfig forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMConfig ConfigOptions
lensOptions
forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
showScrollbarComboBoxText forall a b. (a -> b) -> a -> b
$ ConfigOptions -> ShowScrollbar
showScrollbar ConfigOptions
options
forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
showTabBarComboBoxText forall a b. (a -> b) -> a -> b
$ ConfigOptions -> ShowTabBar
showTabBar ConfigOptions
options
forall a. Show a => ComboBoxText -> a -> IO ()
comboBoxSetActive ComboBoxText
cursorBlinkModeComboBoxText forall a b. (a -> b) -> a -> b
$ ConfigOptions -> CursorBlinkMode
cursorBlinkMode ConfigOptions
options
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpinButton a) =>
a -> Double -> m ()
spinButtonSetValue SpinButton
scrollbackLenSpinButton (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Integer
scrollbackLen ConfigOptions
options)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
confirmExitCheckButton forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
confirmExit ConfigOptions
options
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
showMenuCheckButton forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
showMenu ConfigOptions
options
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
boldIsBrightCheckButton forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
boldIsBright ConfigOptions
options
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
enableSixelCheckButton forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
enableSixel ConfigOptions
options
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> Bool -> m ()
toggleButtonSetActive CheckButton
allowBoldCheckButton forall a b. (a -> b) -> a -> b
$ ConfigOptions -> Bool
allowBold ConfigOptions
options
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntryBuffer a) =>
a -> Text -> Int32 -> m ()
entryBufferSetText EntryBuffer
wordCharExceptionsEntryBuffer (ConfigOptions -> Text
wordCharExceptions ConfigOptions
options) (-Int32
1)
Int32
res <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDialog a) =>
a -> m Int32
dialogRun Dialog
preferencesDialog
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
res) forall a. Eq a => a -> a -> Bool
== ResponseType
ResponseTypeAccept) forall a b. (a -> b) -> a -> b
$ do
Maybe FontDescription
maybeFontDesc <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFontChooser a) =>
a -> m (Maybe FontDescription)
fontChooserGetFontDesc FontButton
fontButton
Maybe FontConfig
maybeFontConfig <-
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FontDescription -> IO (Maybe FontConfig)
fontConfigFromFontDescription Maybe FontDescription
maybeFontDesc
Maybe ShowScrollbar
maybeShowScrollbar <-
forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
showScrollbarComboBoxText [ShowScrollbar
ShowScrollbarNever ..]
Maybe ShowTabBar
maybeShowTabBar <-
forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
showTabBarComboBoxText [ShowTabBar
ShowTabBarNever ..]
Maybe CursorBlinkMode
maybeCursorBlinkMode <-
forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
comboBoxGetActive ComboBoxText
cursorBlinkModeComboBoxText [CursorBlinkMode
CursorBlinkModeSystem ..]
Integer
scrollbackLenVal <-
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSpinButton a) =>
a -> m Int32
spinButtonGetValueAsInt SpinButton
scrollbackLenSpinButton
Bool
confirmExitVal <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
confirmExitCheckButton
Bool
showMenuVal <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
showMenuCheckButton
Bool
boldIsBrightVal <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
boldIsBrightCheckButton
Bool
enableSixelVal <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
enableSixelCheckButton
Bool
allowBoldVal <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToggleButton a) =>
a -> m Bool
toggleButtonGetActive CheckButton
allowBoldCheckButton
Text
wordCharExceptionsVal <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEntryBuffer a) =>
a -> m Text
entryBufferGetText EntryBuffer
wordCharExceptionsEntryBuffer
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ TMState
mvarTMState forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' TMState' FontDescription
lensTMStateFontDesc (forall a. a -> Maybe a -> a
`fromMaybe` Maybe FontDescription
maybeFontDesc)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' TMState' TMConfig
lensTMStateConfig forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' TMConfig ConfigOptions
lensOptions)
( forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Bool
lensConfirmExit Bool
confirmExitVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Bool
lensShowMenu Bool
showMenuVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Bool
lensBoldIsBright Bool
boldIsBrightVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Bool
lensEnableSixel Bool
enableSixelVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Bool
lensAllowBold Bool
allowBoldVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Text
lensWordCharExceptions Text
wordCharExceptionsVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ConfigOptions FontConfig
lensFontConfig (forall a. a -> Maybe a -> a
`fromMaybe` Maybe FontConfig
maybeFontConfig)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ConfigOptions Integer
lensScrollbackLen Integer
scrollbackLenVal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ConfigOptions ShowScrollbar
lensShowScrollbar (forall a. a -> Maybe a -> a
`fromMaybe` Maybe ShowScrollbar
maybeShowScrollbar)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ConfigOptions ShowTabBar
lensShowTabBar (forall a. a -> Maybe a -> a
`fromMaybe` Maybe ShowTabBar
maybeShowTabBar)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ConfigOptions CursorBlinkMode
lensCursorBlinkMode (forall a. a -> Maybe a -> a
`fromMaybe` Maybe CursorBlinkMode
maybeCursorBlinkMode)
)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m b) -> m b
withMVar TMState
mvarTMState forall a b. (a -> b) -> a -> b
$ TMConfig -> IO ()
saveToPreferencesFile forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' TMState' TMConfig
lensTMStateConfig
TMState -> IO ()
applyNewPreferences TMState
mvarTMState
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetDestroy Dialog
preferencesDialog
appStartup :: Application -> IO ()
appStartup :: Application -> IO ()
appStartup Application
_app = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
start :: TMConfig -> IO ()
start :: TMConfig -> IO ()
start TMConfig
tmConfig = do
Application
app <- forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadFail m) =>
Maybe Text -> [ApplicationFlags] -> m Application
appNew forall a. Maybe a
Nothing [ApplicationFlags
ApplicationFlagsFlagsNone]
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsApplication a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onApplicationStartup Application
app (Application -> IO ()
appStartup Application
app)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(IsApplication a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onApplicationActivate Application
app (TMConfig -> Application -> IO ()
appActivate TMConfig
tmConfig Application
app)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> Maybe [FilePath] -> m Int32
applicationRun Application
app forall a. Maybe a
Nothing
defaultMain :: TMConfig -> IO ()
defaultMain :: TMConfig -> IO ()
defaultMain TMConfig
tmConfig = do
let params :: Params (TMConfig, FilePath) ()
params =
forall cfgType a. Params cfgType a
defaultParams
{ projectName :: FilePath
projectName = FilePath
"termonad"
, showError :: (TMConfig, FilePath) -> FilePath -> (TMConfig, FilePath)
showError = \(TMConfig
cfg, FilePath
oldErrs) FilePath
newErr -> (TMConfig
cfg, FilePath
oldErrs forall a. Semigroup a => a -> a -> a
<> FilePath
"\n" forall a. Semigroup a => a -> a -> a
<> FilePath
newErr)
, realMain :: (TMConfig, FilePath) -> IO ()
realMain = \(TMConfig
cfg, FilePath
errs) -> forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (forall seq. IsSequence seq => [Element seq] -> seq
pack FilePath
errs) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TMConfig -> IO ()
start TMConfig
cfg
}
Either IOError ()
eitherRes <- forall a. IO a -> IO (Either IOError a)
tryIOError forall a b. (a -> b) -> a -> b
$ forall cfgType a. Params cfgType a -> cfgType -> IO a
wrapMain Params (TMConfig, FilePath) ()
params (TMConfig
tmConfig, FilePath
"")
case Either IOError ()
eitherRes of
Left IOError
ioErr
| IOError -> IOErrorType
ioeGetErrorType IOError
ioErr forall a. Eq a => a -> a -> Bool
== IOErrorType
doesNotExistErrorType Bool -> Bool -> Bool
&& IOError -> Maybe FilePath
ioeGetFileName IOError
ioErr forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just FilePath
"ghc" -> do
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$
Text
"Could not find ghc on your PATH. Ignoring your termonad.hs " forall a. Semigroup a => a -> a -> a
<>
Text
"configuration file and running termonad with default settings."
TMConfig -> IO ()
start TMConfig
tmConfig
| Bool
otherwise -> do
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"IO error occurred when trying to run termonad:"
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
print IOError
ioErr
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"Don't know how to recover. Exiting."
Right ()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()