From 180472a076398aaab10bbc0302e46dcd48e7df98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Wed, 13 Oct 2021 22:16:15 -0400 Subject: [PATCH 01/19] use Ctrl + keypad plus/minus to control font size on my keyboard, those are much more convenient to press than the regular plus and minus keys. the regular plus key is shift+equals, so increasing the font size requires a ctrl+shift combination while decreasing it only requires ctrl, which is awkward. --- src/Termonad/App.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index d219ea3..642ab0c 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -478,13 +478,13 @@ setupTermonad tmConfig app win builder = do void $ onSimpleActionActivate enlargeFontAction $ \_ -> modifyFontSizeForAllTerms (modFontSize 1) mvarTMState actionMapAddAction app enlargeFontAction - applicationSetAccelsForAction app "app.enlargefont" ["plus"] + applicationSetAccelsForAction app "app.enlargefont" ["KP_Add"] reduceFontAction <- simpleActionNew "reducefont" Nothing void $ onSimpleActionActivate reduceFontAction $ \_ -> modifyFontSizeForAllTerms (modFontSize (-1)) mvarTMState actionMapAddAction app reduceFontAction - applicationSetAccelsForAction app "app.reducefont" ["minus"] + applicationSetAccelsForAction app "app.reducefont" ["KP_Subtract"] findAction <- simpleActionNew "find" Nothing void $ onSimpleActionActivate findAction $ \_ -> doFind mvarTMState From 7080542224b7deecd35e185e5c98836f03df7e20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Fri, 22 Oct 2021 15:39:23 -0400 Subject: [PATCH 02/19] typo --- src/Termonad/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 999ee95..6b7f44d 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -66,7 +66,7 @@ data TMNotebookTab = TMNotebookTab { tmNotebookTabTermContainer :: !ScrolledWindow -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'. , tmNotebookTabTerm :: !TMTerm - -- ^ The 'Terminal' insidie the 'ScrolledWindow'. + -- ^ The 'Terminal' inside the 'ScrolledWindow'. , tmNotebookTabLabel :: !Label -- ^ The 'Label' holding the title of the 'Terminal' in the 'Notebook' tab. } From 51816b87f31416592335717d76c06f768f11c0f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sat, 23 Oct 2021 21:47:23 -0400 Subject: [PATCH 03/19] debugging function, printWidgetTree --- src/Termonad/Types.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 6b7f44d..ff15158 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -25,6 +25,8 @@ import GI.Gtk , notebookGetNthPage , notebookGetNPages ) +import qualified GI.Gtk as Gtk +import Data.GI.Base.GObject import GI.Pango (FontDescription) import GI.Vte (Terminal, CursorBlinkMode(..)) import Text.Pretty.Simple (pPrint) @@ -530,6 +532,23 @@ data TMStateInvariantErr | TabsDoNotMatch TabsDoNotMatch deriving Show +printWidgetTree :: Gtk.IsWidget a => a -> IO () +printWidgetTree widget_ = do + widget <- Gtk.toWidget widget_ + go "" widget + where + go :: Text -> Gtk.Widget -> IO () + go indent w = do + type_ <- gtypeFromInstance w + name <- Gtk.gtypeName type_ + let ptr = Gtk.managedForeignPtr . Gtk.toManagedPtr $ w + putStrLn $ indent <> pack name <> " " <> pack (show ptr) + maybeContainer <- Gtk.castTo Gtk.Container w + for_ maybeContainer $ \container -> do + children <- Gtk.containerGetChildren container + for_ children $ \child -> do + go (" " <> indent) child + -- | Gather up the invariants for 'TMState' and return them as a list. -- -- If no invariants have been violated, then this function should return an From e03bda2ce444dc3dfde46f90472bc650d57eace6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sat, 23 Oct 2021 21:59:33 -0400 Subject: [PATCH 04/19] prototype: put terminals inside a Paned I eventually want to split terminals by replacing one terminal by two terminals inside a Paned. As a first step towards that, can I put every terminal inside a Paned (with a dummy button on the other side of the pane) without breaking the rest of the code? --- src/Termonad/Term.hs | 16 ++++-- src/Termonad/Types.hs | 113 ++++++++++++++++++++++++++---------------- 2 files changed, 83 insertions(+), 46 deletions(-) diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index 8176247..bc99707 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -80,6 +80,7 @@ import GI.Gtk , windowSetFocus , windowSetTransientFor ) +import qualified GI.Gtk as Gtk import GI.Pango (EllipsizeMode(EllipsizeModeMiddle), FontDescription) import GI.Vte ( PtyFlags(PtyFlagsDefault) @@ -411,8 +412,17 @@ addPage mvarTMState notebookTab tabLabelBox = do note = tmNotebook notebook tabs = tmNotebookTabs notebook scrolledWin = tmNotebookTabTermContainer notebookTab - pageIndex <- notebookAppendPage note scrolledWin (Just tabLabelBox) - notebookSetTabReorderable note scrolledWin True + + ---- Create a spurious container and add the scrolling window in it + paned <- Gtk.panedNew Gtk.OrientationVertical + Gtk.panedSetWideHandle paned True + button <- Gtk.buttonNewWithLabel "Button" + Gtk.panedAdd1 paned scrolledWin + Gtk.panedAdd2 paned button + Gtk.widgetShowAll paned + + pageIndex <- notebookAppendPage note paned (Just tabLabelBox) + notebookSetTabReorderable note paned True setShowTabs (tmState ^. lensTMStateConfig) note let newTabs = appendFL tabs notebookTab newTMState = @@ -445,7 +455,7 @@ createTerm handleKeyPress mvarTMState = do termShellPid <- launchShell vteTerm maybeCurrDir tmTerm <- newTMTerm vteTerm termShellPid - -- Create the container add the VTE term in it + -- Create the scrolling window container add the VTE term in it scrolledWin <- createScrolledWin mvarTMState containerAdd scrolledWin vteTerm diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index ff15158..c815fc1 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -4,6 +4,7 @@ module Termonad.Types where import Termonad.Prelude +import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, withExceptT) import Control.Monad.Fail (fail) import Data.FocusList (FocusList, emptyFL, singletonFL, getFocusItemFL, lengthFL) import Data.Unique (Unique, hashUnique, newUnique) @@ -565,7 +566,7 @@ invariantTMState' tmState = runInvariants = fmap catMaybes . sequence invariantFocusSame :: IO (Maybe TMStateInvariantErr) - invariantFocusSame = do + invariantFocusSame = execExceptT $ do let tmNote = tmNotebook $ tmStateNotebook tmState index32 <- notebookGetCurrentPage tmNote maybeWidgetFromNote <- notebookGetNthPage tmNote index32 @@ -574,61 +575,87 @@ invariantTMState' tmState = tmNotebookTabTermContainer <$> getFocusItemFL focusList idx = fromIntegral index32 case (maybeWidgetFromNote, maybeScrollWinFromFL) of - (Nothing, Nothing) -> pure Nothing + (Nothing, Nothing) -> pure () (Just _, Nothing) -> - pure $ - Just $ - FocusNotSame NotebookTabWidgetExistsButNoFocusListFocus idx + throwE $ FocusNotSame NotebookTabWidgetExistsButNoFocusListFocus idx (Nothing, Just _) -> - pure $ - Just $ - FocusNotSame FocusListFocusExistsButNoNotebookTabWidget idx + throwE $ FocusNotSame FocusListFocusExistsButNoNotebookTabWidget idx (Just widgetFromNote, Just scrollWinFromFL) -> do - isEq <- widgetEq widgetFromNote scrollWinFromFL - if isEq - then pure Nothing - else - pure $ - Just $ - FocusNotSame NotebookTabWidgetDiffersFromFocusListFocus idx + withExceptT (\() -> FocusNotSame NotebookTabWidgetDiffersFromFocusListFocus idx) $ do + paneFromNote <- expect Gtk.Paned widgetFromNote + (scrollWinFromNote, _) <- expectTwoChildren paneFromNote + expectSameWidgets scrollWinFromNote scrollWinFromFL invariantTMTabLength :: IO (Maybe TMStateInvariantErr) - invariantTMTabLength = do + invariantTMTabLength = execExceptT $ do let tmNote = tmNotebook $ tmStateNotebook tmState noteLength32 <- notebookGetNPages tmNote let noteLength = fromIntegral noteLength32 focusListLength = lengthFL $ tmNotebookTabs $ tmStateNotebook tmState lengthEqual = focusListLength == noteLength - if lengthEqual - then pure Nothing - else pure $ - Just $ - TabsDoNotMatch $ - TabLengthsDifferent noteLength focusListLength + when (not lengthEqual) $ do + throwE $ TabsDoNotMatch $ TabLengthsDifferent noteLength focusListLength -- Turns a FocusList and Notebook into two lists of widgets and compares each widget for equality invariantTabsAllMatch :: IO (Maybe TMStateInvariantErr) - invariantTabsAllMatch = do - let tmNote = tmNotebook $ tmStateNotebook tmState - focusList = tmNotebookTabs $ tmStateNotebook tmState - flList = tmNotebookTabTermContainer <$> toList focusList - noteList <- notebookToList tmNote - tabsMatch noteList flList - where - tabsMatch - :: forall a b - . (IsWidget a, IsWidget b) - => [a] - -> [b] - -> IO (Maybe TMStateInvariantErr) - tabsMatch xs ys = foldr go (pure Nothing) (zip3 xs ys [0..]) - where - go :: (a, b, Int) -> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr) - go (x, y, i) acc = do - isEq <- widgetEq x y - if isEq - then acc - else pure . Just $ TabsDoNotMatch (TabAtIndexDifferent i) + invariantTabsAllMatch = execExceptT $ do + withExceptT (\i -> TabsDoNotMatch (TabAtIndexDifferent i)) $ do + let tmNote = tmNotebook $ tmStateNotebook tmState + focusList = tmNotebookTabs $ tmStateNotebook tmState + flList = tmNotebookTabTermContainer <$> toList focusList + widgetsFromNote <- liftIO $ notebookToList tmNote + panesFromNote <- for (zip widgetsFromNote [0..]) $ \(widgetFromNote, i) -> do + withExceptT (\() -> i) $ do + expect Gtk.Paned widgetFromNote + scrollWinsFromNote <- for (zip panesFromNote [0..]) $ \(paneFromNote, i) -> do + withExceptT (\() -> i) $ do + (scrollWinFromNote, _) <- expectTwoChildren paneFromNote + pure scrollWinFromNote + for_ (zip3 scrollWinsFromNote flList [0..]) $ \(scrollWinFromNote, scrollWinFromFL, i) -> do + withExceptT (\() -> i) $ do + expectSameWidgets scrollWinFromNote scrollWinFromFL + + expect + :: forall a b + . (IsWidget a, Gtk.GObject b) + => (Gtk.ManagedPtr b -> b) -> a -> ExceptT () IO b + expect mkB x = do + maybeB <- liftIO $ Gtk.castTo mkB x + case maybeB of + Nothing -> do + throwE () + Just box -> do + pure box + + expectTwoChildren + :: forall a + . Gtk.IsContainer a + => a -> ExceptT () IO (Widget, Widget) + expectTwoChildren x = do + children <- Gtk.containerGetChildren x + case children of + [child1, child2] -> do + pure (child1, child2) + _ -> do + throwE () + + expectSameWidgets + :: forall a b + . (IsWidget a, IsWidget b) + => a -> b -> ExceptT () IO () + expectSameWidgets x y = do + isEq <- widgetEq x y + when (not isEq) $ do + throwE () + + execExceptT :: forall e m. Monad m => ExceptT e m () -> m (Maybe e) + execExceptT body = do + eOrUnit <- runExceptT body + case eOrUnit of + Left e -> do + pure (Just e) + Right () -> do + pure Nothing -- | Check the invariants for 'TMState', and call 'fail' if we find that they -- have been violated. From 240f1d8bfa288be4adf2bfc6578a78ee6064d737 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sat, 23 Oct 2021 22:10:54 -0400 Subject: [PATCH 05/19] rename TabTermContainer to TabScrolledWindow I want to add a TabPaned, and it seems weird for the ScrolledWindow to be identified more vaguely than the other widgets surrounding the terminal. --- src/Termonad/App.hs | 8 ++++---- src/Termonad/Lenses.hs | 2 +- src/Termonad/Term.hs | 10 +++++----- src/Termonad/Types.hs | 12 ++++++------ 4 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index 642ab0c..472961e 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -138,8 +138,8 @@ import Termonad.Lenses , lensShowTabBar , lensScrollbackLen , lensTMNotebook - , lensTMNotebookTabTermContainer , lensTMNotebookTabs + , lensTMNotebookTabScrolledWindow , lensTMNotebookTabTerm , lensTMStateApp , lensTMStateAppWin @@ -172,8 +172,8 @@ import Termonad.Types , getFocusedTermFromState , modFontSize , newEmptyTMState - , tmNotebookTabTermContainer , tmNotebookTabs + , tmNotebookTabScrolledWindow , tmStateApp , tmStateNotebook ) @@ -279,7 +279,7 @@ fontConfigFromFontDescription fontDescription = do compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool compareScrolledWinAndTab scrollWin flTab = - let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer flTab + let ScrolledWindow managedPtrFLTab = tmNotebookTabScrolledWindow flTab foreignPtrFLTab = managedForeignPtr managedPtrFLTab ScrolledWindow managedPtrScrollWin = scrollWin foreignPtrScrollWin = managedForeignPtr managedPtrScrollWin @@ -720,7 +720,7 @@ applyNewPreferencesToTab mvarTMState tab = do tmState <- readMVar mvarTMState let fontDesc = tmState ^. lensTMStateFontDesc term = tab ^. lensTMNotebookTabTerm . lensTerm - scrolledWin = tab ^. lensTMNotebookTabTermContainer + scrolledWin = tab ^. lensTMNotebookTabScrolledWindow options = tmState ^. lensTMStateConfig . lensOptions terminalSetFont term (Just fontDesc) terminalSetCursorBlinkMode term (cursorBlinkMode options) diff --git a/src/Termonad/Lenses.hs b/src/Termonad/Lenses.hs index 1cfcb8c..1975a53 100644 --- a/src/Termonad/Lenses.hs +++ b/src/Termonad/Lenses.hs @@ -14,7 +14,7 @@ $(makeLensesFor ) $(makeLensesFor - [ ("tmNotebookTabTermContainer", "lensTMNotebookTabTermContainer") + [ ("tmNotebookTabScrolledWindow", "lensTMNotebookTabScrolledWindow") , ("tmNotebookTabTerm", "lensTMNotebookTabTerm") , ("tmNotebookTabLabel", "lensTMNotebookTabLabel") ] diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index bc99707..5bc6cc0 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -105,8 +105,8 @@ import Termonad.Lenses , lensShowScrollbar , lensShowTabBar , lensTMNotebookTabLabel + , lensTMNotebookTabScrolledWindow , lensTMNotebookTabTerm - , lensTMNotebookTabTermContainer , lensTMNotebookTabs , lensTMStateApp , lensTMStateConfig @@ -129,8 +129,8 @@ import Termonad.Types , newTMTerm , pid , tmNotebook + , tmNotebookTabScrolledWindow , tmNotebookTabTerm - , tmNotebookTabTermContainer , tmNotebookTabs ) @@ -204,7 +204,7 @@ termExit tab mvarTMState = do detachTabAction = notebookDetachTab (tmNotebook notebook) - (tmNotebookTabTermContainer tab) + (tmNotebookTabScrolledWindow tab) let newTabs = deleteFL tab (tmNotebookTabs notebook) let newTMState = set (lensTMStateNotebook . lensTMNotebookTabs) newTabs tmState @@ -222,7 +222,7 @@ relabelTabs mvarTMState = do go :: Notebook -> TMNotebookTab -> IO () go notebook tmNotebookTab = do let label = tmNotebookTab ^. lensTMNotebookTabLabel - scrolledWin = tmNotebookTab ^. lensTMNotebookTabTermContainer + scrolledWin = tmNotebookTab ^. lensTMNotebookTabScrolledWindow term' = tmNotebookTab ^. lensTMNotebookTabTerm . lensTerm relabelTab notebook label scrolledWin term' @@ -411,7 +411,7 @@ addPage mvarTMState notebookTab tabLabelBox = do let notebook = tmStateNotebook tmState note = tmNotebook notebook tabs = tmNotebookTabs notebook - scrolledWin = tmNotebookTabTermContainer notebookTab + scrolledWin = tmNotebookTabScrolledWindow notebookTab ---- Create a spurious container and add the scrolling window in it paned <- Gtk.panedNew Gtk.OrientationVertical diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index c815fc1..8504dcf 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -63,10 +63,10 @@ instance Show TMTerm where showString "}" -- | A container that holds everything in a given terminal window. The 'term' --- in the 'TMTerm' is inside the 'tmNotebookTabTermContainer' 'ScrolledWindow'. +-- in the 'TMTerm' is inside the 'tmNotebookTabScrolledWindow' 'ScrolledWindow'. -- The notebook tab 'Label' is also available. data TMNotebookTab = TMNotebookTab - { tmNotebookTabTermContainer :: !ScrolledWindow + { tmNotebookTabScrolledWindow :: !ScrolledWindow -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'. , tmNotebookTabTerm :: !TMTerm -- ^ The 'Terminal' inside the 'ScrolledWindow'. @@ -79,7 +79,7 @@ instance Show TMNotebookTab where showsPrec d TMNotebookTab{..} = showParen (d > 10) $ showString "TMNotebookTab {" . - showString "tmNotebookTabTermContainer = " . + showString "tmNotebookTabScrolledWindow = " . showString "(GI.GTK.ScrolledWindow)" . showString ", " . showString "tmNotebookTabTerm = " . @@ -173,7 +173,7 @@ getFocusedTermFromState mvarTMState = createTMNotebookTab :: Label -> ScrolledWindow -> TMTerm -> TMNotebookTab createTMNotebookTab tabLabel scrollWin trm = TMNotebookTab - { tmNotebookTabTermContainer = scrollWin + { tmNotebookTabScrolledWindow = scrollWin , tmNotebookTabTerm = trm , tmNotebookTabLabel = tabLabel } @@ -572,7 +572,7 @@ invariantTMState' tmState = maybeWidgetFromNote <- notebookGetNthPage tmNote index32 let focusList = tmNotebookTabs $ tmStateNotebook tmState maybeScrollWinFromFL = - tmNotebookTabTermContainer <$> getFocusItemFL focusList + tmNotebookTabScrolledWindow <$> getFocusItemFL focusList idx = fromIntegral index32 case (maybeWidgetFromNote, maybeScrollWinFromFL) of (Nothing, Nothing) -> pure () @@ -602,7 +602,7 @@ invariantTMState' tmState = withExceptT (\i -> TabsDoNotMatch (TabAtIndexDifferent i)) $ do let tmNote = tmNotebook $ tmStateNotebook tmState focusList = tmNotebookTabs $ tmStateNotebook tmState - flList = tmNotebookTabTermContainer <$> toList focusList + flList = tmNotebookTabScrolledWindow <$> toList focusList widgetsFromNote <- liftIO $ notebookToList tmNote panesFromNote <- for (zip widgetsFromNote [0..]) $ \(widgetFromNote, i) -> do withExceptT (\() -> i) $ do From e5226ed4107e7365ee472e372c497b8a88ced898 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sat, 23 Oct 2021 22:19:40 -0400 Subject: [PATCH 06/19] track the Paned in the TMNotebookTab --- src/Termonad/Lenses.hs | 3 ++- src/Termonad/Term.hs | 21 +++++++++++---------- src/Termonad/Types.hs | 17 +++++++++++------ 3 files changed, 24 insertions(+), 17 deletions(-) diff --git a/src/Termonad/Lenses.hs b/src/Termonad/Lenses.hs index 1975a53..ca1b9f1 100644 --- a/src/Termonad/Lenses.hs +++ b/src/Termonad/Lenses.hs @@ -14,7 +14,8 @@ $(makeLensesFor ) $(makeLensesFor - [ ("tmNotebookTabScrolledWindow", "lensTMNotebookTabScrolledWindow") + [ ("tmNotebookTabPaned", "lensTMNotebookTabPaned") + , ("tmNotebookTabScrolledWindow", "lensTMNotebookTabScrolledWindow") , ("tmNotebookTabTerm", "lensTMNotebookTabTerm") , ("tmNotebookTabLabel", "lensTMNotebookTabLabel") ] diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index 5bc6cc0..f0e42e3 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -129,6 +129,7 @@ import Termonad.Types , newTMTerm , pid , tmNotebook + , tmNotebookTabPaned , tmNotebookTabScrolledWindow , tmNotebookTabTerm , tmNotebookTabs @@ -411,15 +412,7 @@ addPage mvarTMState notebookTab tabLabelBox = do let notebook = tmStateNotebook tmState note = tmNotebook notebook tabs = tmNotebookTabs notebook - scrolledWin = tmNotebookTabScrolledWindow notebookTab - - ---- Create a spurious container and add the scrolling window in it - paned <- Gtk.panedNew Gtk.OrientationVertical - Gtk.panedSetWideHandle paned True - button <- Gtk.buttonNewWithLabel "Button" - Gtk.panedAdd1 paned scrolledWin - Gtk.panedAdd2 paned button - Gtk.widgetShowAll paned + paned = tmNotebookTabPaned notebookTab pageIndex <- notebookAppendPage note paned (Just tabLabelBox) notebookSetTabReorderable note paned True @@ -459,11 +452,19 @@ createTerm handleKeyPress mvarTMState = do scrolledWin <- createScrolledWin mvarTMState containerAdd scrolledWin vteTerm + -- Create the paned window container add the VTE term in it + paned <- Gtk.panedNew Gtk.OrientationVertical + Gtk.panedSetWideHandle paned True + button <- Gtk.buttonNewWithLabel "Button" + Gtk.panedAdd1 paned scrolledWin + Gtk.panedAdd2 paned button + Gtk.widgetShowAll paned + -- Create the GTK widget for the Notebook tab (tabLabelBox, tabLabel, tabCloseButton) <- createNotebookTabLabel -- Create notebook state - let notebookTab = createTMNotebookTab tabLabel scrolledWin tmTerm + let notebookTab = createTMNotebookTab tabLabel paned scrolledWin tmTerm -- Add the new notebooktab to the notebook. addPage mvarTMState notebookTab tabLabelBox diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 8504dcf..751c7b0 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -20,6 +20,7 @@ import GI.Gtk , IsWidget , Label , Notebook + , Paned , ScrolledWindow , Widget , notebookGetCurrentPage @@ -66,7 +67,9 @@ instance Show TMTerm where -- in the 'TMTerm' is inside the 'tmNotebookTabScrolledWindow' 'ScrolledWindow'. -- The notebook tab 'Label' is also available. data TMNotebookTab = TMNotebookTab - { tmNotebookTabScrolledWindow :: !ScrolledWindow + { tmNotebookTabPaned :: !Paned + -- ^ The 'Paned' holding the 'ScrolledWindow'. + , tmNotebookTabScrolledWindow :: !ScrolledWindow -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'. , tmNotebookTabTerm :: !TMTerm -- ^ The 'Terminal' inside the 'ScrolledWindow'. @@ -170,10 +173,11 @@ getFocusedTermFromState mvarTMState = getFocusItemFL $ tmNotebookTabs $ tmStateNotebook tmState pure $ fmap (term . tmNotebookTabTerm) maybeNotebookTab -createTMNotebookTab :: Label -> ScrolledWindow -> TMTerm -> TMNotebookTab -createTMNotebookTab tabLabel scrollWin trm = +createTMNotebookTab :: Label -> Paned -> ScrolledWindow -> TMTerm -> TMNotebookTab +createTMNotebookTab tabLabel paned scrollWin trm = TMNotebookTab - { tmNotebookTabScrolledWindow = scrollWin + { tmNotebookTabPaned = paned + , tmNotebookTabScrolledWindow = scrollWin , tmNotebookTabTerm = trm , tmNotebookTabLabel = tabLabel } @@ -226,14 +230,15 @@ newTMStateSingleTerm :: -> ApplicationWindow -> Notebook -> Label + -> Paned -> ScrolledWindow -> Terminal -> Int -> FontDescription -> IO TMState -newTMStateSingleTerm tmConfig app appWin note label scrollWin trm pd fontDesc = do +newTMStateSingleTerm tmConfig app appWin note label paned scrollWin trm pd fontDesc = do tmTerm <- newTMTerm trm pd - let tmNoteTab = createTMNotebookTab label scrollWin tmTerm + let tmNoteTab = createTMNotebookTab label paned scrollWin tmTerm tabs = singletonFL tmNoteTab tmNote = createTMNotebook note tabs newTMState tmConfig app appWin tmNote fontDesc From 43d04e75fd6f959c1aafd0f1089ee2f568443d01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 13:14:08 -0400 Subject: [PATCH 07/19] look for the Paned, not the ScrolledWindow compareScrolledWinAndTab was used to find the FLTab entry corresponding to a given Widget in a Notebook. Now that Notebook entries are Paned widgets containing a ScrolledWindow containing a terminal, and not simply a ScrolledWindow containing a terminal, we need to search for the Paned, not for the ScrolledWindow. --- src/Termonad/App.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index 472961e..bb935d2 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -29,10 +29,10 @@ import GI.Gtk , Entry(Entry) , FontButton(FontButton) , Label(Label) + , Paned(Paned) , PolicyType(PolicyTypeAutomatic) , PositionType(PositionTypeRight) , ResponseType(ResponseTypeAccept, ResponseTypeNo, ResponseTypeYes) - , ScrolledWindow(ScrolledWindow) , SpinButton(SpinButton) , pattern STYLE_PROVIDER_PRIORITY_APPLICATION , aboutDialogNew @@ -173,7 +173,7 @@ import Termonad.Types , modFontSize , newEmptyTMState , tmNotebookTabs - , tmNotebookTabScrolledWindow + , tmNotebookTabPaned , tmStateApp , tmStateNotebook ) @@ -277,13 +277,13 @@ fontConfigFromFontDescription fontDescription = do maybeFontFamily <- fontDescriptionGetFamily fontDescription return $ (`FontConfig` fontSize) <$> maybeFontFamily -compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool -compareScrolledWinAndTab scrollWin flTab = - let ScrolledWindow managedPtrFLTab = tmNotebookTabScrolledWindow flTab +comparePanedAndTab :: Paned -> TMNotebookTab -> Bool +comparePanedAndTab paned flTab = + let Paned managedPtrFLTab = tmNotebookTabPaned flTab foreignPtrFLTab = managedForeignPtr managedPtrFLTab - ScrolledWindow managedPtrScrollWin = scrollWin - foreignPtrScrollWin = managedForeignPtr managedPtrScrollWin - in foreignPtrFLTab == foreignPtrScrollWin + Paned managedPtrPaned = paned + foreignPtrPaned = managedForeignPtr managedPtrPaned + in foreignPtrFLTab == foreignPtrPaned updateFLTabPos :: TMState -> Int -> Int -> IO () updateFLTabPos mvarTMState oldPos newPos = @@ -404,23 +404,23 @@ setupTermonad tmConfig app win builder = do lensTMStateNotebook . lensTMNotebookTabs .~ newTabs void $ onNotebookPageReordered note $ \childWidg pageNum -> do - maybeScrollWin <- castTo ScrolledWindow childWidg - case maybeScrollWin of + maybePaned <- castTo Paned childWidg + case maybePaned of Nothing -> fail $ "In setupTermonad, in callback for onNotebookPageReordered, " <> - "child widget is not a ScrolledWindow.\n" <> + "child widget is not a Paned.\n" <> "Don't know how to continue.\n" - Just scrollWin -> do + Just paned -> do TMState{tmStateNotebook} <- readMVar mvarTMState let fl = tmStateNotebook ^. lensTMNotebookTabs let maybeOldPosition = - findIndexR (compareScrolledWinAndTab scrollWin) (focusList fl) + findIndexR (comparePanedAndTab paned) (focusList fl) case maybeOldPosition of Nothing -> fail $ "In setupTermonad, in callback for onNotebookPageReordered, " <> - "the ScrolledWindow is not already in the FocusList.\n" <> + "the Paned is not already in the FocusList.\n" <> "Don't know how to continue.\n" Just oldPos -> do updateFLTabPos mvarTMState oldPos (fromIntegral pageNum) From e582ec206f8c4348e5439c0fc148f353de97a66e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 13:45:47 -0400 Subject: [PATCH 08/19] include Paned field in Show instance We can't show a Paned any more that we can show a ScrolledWindow, but at least we can include a dummy entry for it in the Show instance, to match the record's real shape. --- src/Termonad/Types.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 751c7b0..bfa77b2 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -82,6 +82,9 @@ instance Show TMNotebookTab where showsPrec d TMNotebookTab{..} = showParen (d > 10) $ showString "TMNotebookTab {" . + showString "tmNotebookTabPaned = " . + showString "(GI.GTK.Paned)" . + showString ", " . showString "tmNotebookTabScrolledWindow = " . showString "(GI.GTK.ScrolledWindow)" . showString ", " . From 5a6afe6349edfd267291ca09f21275d771247cb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 13:59:04 -0400 Subject: [PATCH 09/19] detach the Paned on terminal exit We were previously trying to detach the ScrolledWindow, but since the Notebook now contains Paned widgets, it was not found and the tab was not detached. --- src/Termonad/Term.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index f0e42e3..7faa4b3 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -130,7 +130,6 @@ import Termonad.Types , pid , tmNotebook , tmNotebookTabPaned - , tmNotebookTabScrolledWindow , tmNotebookTabTerm , tmNotebookTabs ) @@ -205,7 +204,7 @@ termExit tab mvarTMState = do detachTabAction = notebookDetachTab (tmNotebook notebook) - (tmNotebookTabScrolledWindow tab) + (tmNotebookTabPaned tab) let newTabs = deleteFL tab (tmNotebookTabs notebook) let newTMState = set (lensTMStateNotebook . lensTMNotebookTabs) newTabs tmState From b8aa4b04a9e5fa1fdbadc07396c19d056c77b1c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 14:11:35 -0400 Subject: [PATCH 10/19] correct TMNotebookTab's comment so that it also describes the new Paned field. --- src/Termonad/Types.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index bfa77b2..e3a1c07 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -63,9 +63,10 @@ instance Show TMTerm where showsPrec (d + 1) (hashUnique unique) . showString "}" --- | A container that holds everything in a given terminal window. The 'term' --- in the 'TMTerm' is inside the 'tmNotebookTabScrolledWindow' 'ScrolledWindow'. --- The notebook tab 'Label' is also available. +-- | A container that holds everything in a given notebook tab. The 'term' in +-- the 'TMTerm' is inside the 'tmNotebookTabScrolledWindow' 'ScrolledWindow', +-- which is in turn inside the 'tmNotebookTabPaned' 'Paned'. The notebook tab +-- 'Label' is also available. data TMNotebookTab = TMNotebookTab { tmNotebookTabPaned :: !Paned -- ^ The 'Paned' holding the 'ScrolledWindow'. From 484ed1dc587a35df665b67d661ed3dfe4d8c766c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 14:19:47 -0400 Subject: [PATCH 11/19] relabel based on the Paned Like the last few commits, the relabelling code was looking for a ScrolledWindow but should now be looking for a Paned. --- src/Termonad/Term.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index 7faa4b3..d508788 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -36,6 +36,7 @@ import GI.Gtk , Label , Notebook , Orientation(OrientationHorizontal) + , Paned , PolicyType(PolicyTypeAlways, PolicyTypeAutomatic, PolicyTypeNever) , ReliefStyle(ReliefStyleNone) , ResponseType(ResponseTypeNo, ResponseTypeYes) @@ -105,7 +106,7 @@ import Termonad.Lenses , lensShowScrollbar , lensShowTabBar , lensTMNotebookTabLabel - , lensTMNotebookTabScrolledWindow + , lensTMNotebookTabPaned , lensTMNotebookTabTerm , lensTMNotebookTabs , lensTMStateApp @@ -222,9 +223,9 @@ relabelTabs mvarTMState = do go :: Notebook -> TMNotebookTab -> IO () go notebook tmNotebookTab = do let label = tmNotebookTab ^. lensTMNotebookTabLabel - scrolledWin = tmNotebookTab ^. lensTMNotebookTabScrolledWindow + paned = tmNotebookTab ^. lensTMNotebookTabPaned term' = tmNotebookTab ^. lensTMNotebookTabTerm . lensTerm - relabelTab notebook label scrolledWin term' + relabelTab notebook label paned term' -- | Compute the text for a 'Label' for a GTK Notebook tab. -- @@ -250,9 +251,9 @@ computeTabLabel pageNum maybeTitle = -- | 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 scrolledWin term' = do - tabNum <- notebookPageNum notebook scrolledWin +relabelTab :: Notebook -> Label -> Paned -> Terminal -> IO () +relabelTab notebook label paned term' = do + tabNum <- notebookPageNum notebook paned maybeTitle <- terminalGetWindowTitle term' let labelText = computeTabLabel (fromIntegral tabNum) maybeTitle labelSetLabel label labelText @@ -471,14 +472,14 @@ createTerm handleKeyPress mvarTMState = do -- 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. - relabelTab (tmNotebook currNote) tabLabel scrolledWin vteTerm + relabelTab (tmNotebook currNote) tabLabel paned vteTerm -- Connect callbacks void $ onButtonClicked tabCloseButton $ termClose notebookTab mvarTMState void $ onTerminalWindowTitleChanged vteTerm $ do TMState{tmStateNotebook} <- readMVar mvarTMState let notebook = tmNotebook tmStateNotebook - relabelTab notebook tabLabel scrolledWin vteTerm + relabelTab notebook tabLabel paned vteTerm void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState void $ onWidgetButtonPressEvent vteTerm $ handleMousePress vteTerm From 1cb1bc9711ce9b4165d56f5c2ffad2b6a142d52d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 14:31:47 -0400 Subject: [PATCH 12/19] more straightforward invariant checks I previously edited the invariant checks so they would drill down the Paned in order to find the ScrolledWindow and compare it with the TMNotebookTab's ScrolledWindow. But directly comparing the Paned with the TMNotebookTab's Paned is much simpler. --- src/Termonad/Types.hs | 49 +++++++------------------------------------ 1 file changed, 8 insertions(+), 41 deletions(-) diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index e3a1c07..374265f 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -580,20 +580,18 @@ invariantTMState' tmState = index32 <- notebookGetCurrentPage tmNote maybeWidgetFromNote <- notebookGetNthPage tmNote index32 let focusList = tmNotebookTabs $ tmStateNotebook tmState - maybeScrollWinFromFL = - tmNotebookTabScrolledWindow <$> getFocusItemFL focusList + maybePanedFromFL = + tmNotebookTabPaned <$> getFocusItemFL focusList idx = fromIntegral index32 - case (maybeWidgetFromNote, maybeScrollWinFromFL) of + case (maybeWidgetFromNote, maybePanedFromFL) of (Nothing, Nothing) -> pure () (Just _, Nothing) -> throwE $ FocusNotSame NotebookTabWidgetExistsButNoFocusListFocus idx (Nothing, Just _) -> throwE $ FocusNotSame FocusListFocusExistsButNoNotebookTabWidget idx - (Just widgetFromNote, Just scrollWinFromFL) -> do + (Just widgetFromNote, Just panedFromFL) -> do withExceptT (\() -> FocusNotSame NotebookTabWidgetDiffersFromFocusListFocus idx) $ do - paneFromNote <- expect Gtk.Paned widgetFromNote - (scrollWinFromNote, _) <- expectTwoChildren paneFromNote - expectSameWidgets scrollWinFromNote scrollWinFromFL + expectSameWidgets widgetFromNote panedFromFL invariantTMTabLength :: IO (Maybe TMStateInvariantErr) invariantTMTabLength = execExceptT $ do @@ -611,42 +609,11 @@ invariantTMState' tmState = withExceptT (\i -> TabsDoNotMatch (TabAtIndexDifferent i)) $ do let tmNote = tmNotebook $ tmStateNotebook tmState focusList = tmNotebookTabs $ tmStateNotebook tmState - flList = tmNotebookTabScrolledWindow <$> toList focusList + flList = tmNotebookTabPaned <$> toList focusList widgetsFromNote <- liftIO $ notebookToList tmNote - panesFromNote <- for (zip widgetsFromNote [0..]) $ \(widgetFromNote, i) -> do + for_ (zip3 widgetsFromNote flList [0..]) $ \(scrollWinFromNote, panedFromFL, i) -> do withExceptT (\() -> i) $ do - expect Gtk.Paned widgetFromNote - scrollWinsFromNote <- for (zip panesFromNote [0..]) $ \(paneFromNote, i) -> do - withExceptT (\() -> i) $ do - (scrollWinFromNote, _) <- expectTwoChildren paneFromNote - pure scrollWinFromNote - for_ (zip3 scrollWinsFromNote flList [0..]) $ \(scrollWinFromNote, scrollWinFromFL, i) -> do - withExceptT (\() -> i) $ do - expectSameWidgets scrollWinFromNote scrollWinFromFL - - expect - :: forall a b - . (IsWidget a, Gtk.GObject b) - => (Gtk.ManagedPtr b -> b) -> a -> ExceptT () IO b - expect mkB x = do - maybeB <- liftIO $ Gtk.castTo mkB x - case maybeB of - Nothing -> do - throwE () - Just box -> do - pure box - - expectTwoChildren - :: forall a - . Gtk.IsContainer a - => a -> ExceptT () IO (Widget, Widget) - expectTwoChildren x = do - children <- Gtk.containerGetChildren x - case children of - [child1, child2] -> do - pure (child1, child2) - _ -> do - throwE () + expectSameWidgets scrollWinFromNote panedFromFL expectSameWidgets :: forall a b From c1d08349103d3ebbfc0ae2091ec8912a3d7c68f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 20:01:50 -0400 Subject: [PATCH 13/19] two terminals per tab --- src/Termonad/App.hs | 7 ++++--- src/Termonad/Term.hs | 45 +++++++++++++++++++++++++++++++------------- 2 files changed, 36 insertions(+), 16 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index bb935d2..d8a9cf2 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -151,7 +151,7 @@ import Termonad.Lenses ) import Termonad.PreferencesFile (saveToPreferencesFile) import Termonad.Term - ( createTerm + ( createTerms , relabelTabs , termNextPage , termPrevPage @@ -382,7 +382,7 @@ setupTermonad tmConfig app win builder = do boxPackStart box note True True 0 mvarTMState <- newEmptyTMState tmConfig app win note fontDesc - terminal <- createTerm handleKeyPress mvarTMState + (terminal, _terminal2) <- createTerms handleKeyPress mvarTMState void $ onNotebookPageRemoved note $ \_ _ -> do pages <- notebookGetNPages note @@ -427,7 +427,7 @@ setupTermonad tmConfig app win builder = do relabelTabs mvarTMState newTabAction <- simpleActionNew "newtab" Nothing - void $ onSimpleActionActivate newTabAction $ \_ -> void $ createTerm handleKeyPress mvarTMState + void $ onSimpleActionActivate newTabAction $ \_ -> void $ createTerms handleKeyPress mvarTMState actionMapAddAction app newTabAction applicationSetAccelsForAction app "app.newtab" ["T"] @@ -528,6 +528,7 @@ setupTermonad tmConfig app win builder = do ResponseTypeYes -> False _ -> True + -- Focus on the first terminal widgetShowAll win widgetGrabFocus $ terminal ^. lensTerm diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index d508788..3678de5 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -428,13 +428,14 @@ setFocusOn tmStateAppWin vteTerm = do widgetGrabFocus vteTerm windowSetFocus tmStateAppWin (Just vteTerm) --- | Create a new 'TMTerm', setting it up and adding it to the GTKNotebook. -createTerm +-- | Create two new 'TMTerm's, setting them up and adding them to the +-- GTKNotebook. +createTerms :: (TMState -> EventKey -> IO Bool) -- ^ Funtion for handling key presses on the terminal. -> TMState - -> IO TMTerm -createTerm handleKeyPress mvarTMState = do + -> IO (TMTerm, TMTerm) +createTerms handleKeyPress mvarTMState = do -- Check preconditions assertInvariantTMState mvarTMState @@ -444,20 +445,31 @@ createTerm handleKeyPress mvarTMState = do -- Create a new terminal and launch a shell in it vteTerm <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig) - maybeCurrDir <- getCWDFromFocusedTab currNote - termShellPid <- launchShell vteTerm maybeCurrDir - tmTerm <- newTMTerm vteTerm termShellPid + tmTerm <- do + maybeCurrDir <- getCWDFromFocusedTab currNote + termShellPid <- launchShell vteTerm maybeCurrDir + newTMTerm vteTerm termShellPid -- Create the scrolling window container add the VTE term in it scrolledWin <- createScrolledWin mvarTMState containerAdd scrolledWin vteTerm + -- Create a second terminal and launch a second shell in it + vteTerm2 <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig) + tmTerm2 <- do + maybeCurrDir <- getCWDFromFocusedTab currNote + termShellPid <- launchShell vteTerm2 maybeCurrDir + newTMTerm vteTerm termShellPid + + -- Create a second scrolling window container add the VTE term in it + scrolledWin2 <- createScrolledWin mvarTMState + containerAdd scrolledWin2 vteTerm2 + -- Create the paned window container add the VTE term in it paned <- Gtk.panedNew Gtk.OrientationVertical Gtk.panedSetWideHandle paned True - button <- Gtk.buttonNewWithLabel "Button" Gtk.panedAdd1 paned scrolledWin - Gtk.panedAdd2 paned button + Gtk.panedAdd2 paned scrolledWin2 Gtk.widgetShowAll paned -- Create the GTK widget for the Notebook tab @@ -471,7 +483,9 @@ createTerm handleKeyPress mvarTMState = do -- 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. + -- appropriately. There are two terminals and only one tab label, so we use + -- the first terminal's title. + -- TODO: use the most recently-focused terminal instead. relabelTab (tmNotebook currNote) tabLabel paned vteTerm -- Connect callbacks @@ -484,16 +498,21 @@ createTerm handleKeyPress mvarTMState = do void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState void $ onWidgetButtonPressEvent vteTerm $ handleMousePress vteTerm void $ onTerminalChildExited vteTerm $ \_ -> termExit notebookTab mvarTMState + void $ onWidgetKeyPressEvent vteTerm2 $ handleKeyPress mvarTMState + void $ onWidgetKeyPressEvent scrolledWin2 $ handleKeyPress mvarTMState + void $ onWidgetButtonPressEvent vteTerm2 $ handleMousePress vteTerm2 + void $ onTerminalChildExited vteTerm2 $ \_ -> termExit notebookTab mvarTMState - -- Put the keyboard focus on the term + -- Put the keyboard focus on the first term setFocusOn tmStateAppWin vteTerm -- Make sure the state is still right assertInvariantTMState mvarTMState - -- Run user-defined hooks for modifying the newly-created VTE Terminal. + -- Run user-defined hooks for modifying the newly-created VTE Terminals. createTermHook (hooks tmStateConfig) mvarTMState vteTerm - pure tmTerm + createTermHook (hooks tmStateConfig) mvarTMState vteTerm2 + pure (tmTerm, tmTerm2) -- | Popup the context menu on right click handleMousePress :: Terminal -> EventButton -> IO Bool From 4088f70e21a1c25b4d9c9fcd8cb2f25d31b9fbab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 24 Oct 2021 21:11:28 -0400 Subject: [PATCH 14/19] split the space equally between terminals --- src/Termonad/Term.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index 3678de5..fe05ff9 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -466,10 +466,10 @@ createTerms handleKeyPress mvarTMState = do containerAdd scrolledWin2 vteTerm2 -- Create the paned window container add the VTE term in it - paned <- Gtk.panedNew Gtk.OrientationVertical + paned <- Gtk.panedNew OrientationHorizontal Gtk.panedSetWideHandle paned True - Gtk.panedAdd1 paned scrolledWin - Gtk.panedAdd2 paned scrolledWin2 + Gtk.panedPack1 paned scrolledWin True True + Gtk.panedPack2 paned scrolledWin2 True True Gtk.widgetShowAll paned -- Create the GTK widget for the Notebook tab From a0618c0531e6d7ade012af8b4f0dd671e07d4c7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Mon, 25 Oct 2021 22:25:48 -0400 Subject: [PATCH 15/19] track both terminals in the TMNotebookTab Since each of the two terminals have a ScrolledWindow associated with them, this required moving the ScrolledWindow field from the TMNotebookTab to the TMTerm. More importantly, this refactoring revealed many places where the two terminals were treated differently, and that code was changed to treat both terminals the same. This was made easier by the addition of a lens pointing to the focused terminal (which is currently always the left terminal), and a traversal pointing at both terminals. --- src/Termonad/App.hs | 26 +++++++----- src/Termonad/Lenses.hs | 26 ++++++++++-- src/Termonad/Term.hs | 91 +++++++++++++++++++---------------------- src/Termonad/Types.hs | 92 +++++++++++++++++++++++++----------------- 4 files changed, 135 insertions(+), 100 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index d8a9cf2..8642c04 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -138,16 +138,17 @@ import Termonad.Lenses , lensShowTabBar , lensScrollbackLen , lensTMNotebook + , lensTMNotebookTabFocusedTerm , lensTMNotebookTabs - , lensTMNotebookTabScrolledWindow - , lensTMNotebookTabTerm , lensTMStateApp , lensTMStateAppWin , lensTMStateConfig , lensTMStateFontDesc , lensTMStateNotebook + , lensTMTermScrolledWindow , lensTerm , lensWordCharExceptions + , traversalTMNotebookTabTerms ) import Termonad.PreferencesFile (saveToPreferencesFile) import Termonad.Term @@ -169,6 +170,7 @@ import Termonad.Types , TMNotebookTab , TMState , TMState'(TMState) + , TMTerm , getFocusedTermFromState , modFontSize , newEmptyTMState @@ -257,7 +259,7 @@ modifyFontSizeForAllTerms modFontSizeFunc mvarTMState = do lensTMStateNotebook . lensTMNotebookTabs . traverse . - lensTMNotebookTabTerm . + traversalTMNotebookTabTerms . lensTerm foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms @@ -382,7 +384,7 @@ setupTermonad tmConfig app win builder = do boxPackStart box note True True 0 mvarTMState <- newEmptyTMState tmConfig app win note fontDesc - (terminal, _terminal2) <- createTerms handleKeyPress mvarTMState + (terminalL, _terminalR) <- createTerms handleKeyPress mvarTMState void $ onNotebookPageRemoved note $ \_ _ -> do pages <- notebookGetNPages note @@ -398,7 +400,7 @@ setupTermonad tmConfig app win builder = do case maybeNewTabs of Nothing -> pure tmState Just (tab, newTabs) -> do - widgetGrabFocus $ tab ^. lensTMNotebookTabTerm . lensTerm + widgetGrabFocus $ tab ^. lensTMNotebookTabFocusedTerm . lensTerm pure $ tmState & lensTMStateNotebook . lensTMNotebookTabs .~ newTabs @@ -528,9 +530,9 @@ setupTermonad tmConfig app win builder = do ResponseTypeYes -> False _ -> True - -- Focus on the first terminal + -- Focus on the left terminal widgetShowAll win - widgetGrabFocus $ terminal ^. lensTerm + widgetGrabFocus $ terminalL ^. lensTerm appActivate :: TMConfig -> Application -> IO () appActivate tmConfig app = do @@ -718,10 +720,15 @@ applyNewPreferences mvarTMState = do applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO () applyNewPreferencesToTab mvarTMState tab = do + for_ (tab ^.. traversalTMNotebookTabTerms) $ \tmTerm -> do + applyNewPreferencesToTerm mvarTMState tmTerm + +applyNewPreferencesToTerm :: TMState -> TMTerm -> IO () +applyNewPreferencesToTerm mvarTMState tmTerm = do tmState <- readMVar mvarTMState let fontDesc = tmState ^. lensTMStateFontDesc - term = tab ^. lensTMNotebookTabTerm . lensTerm - scrolledWin = tab ^. lensTMNotebookTabScrolledWindow + term = tmTerm ^. lensTerm + scrolledWin = tmTerm ^. lensTMTermScrolledWindow options = tmState ^. lensTMStateConfig . lensOptions terminalSetFont term (Just fontDesc) terminalSetCursorBlinkMode term (cursorBlinkMode options) @@ -732,6 +739,7 @@ applyNewPreferencesToTab mvarTMState tab = do let vScrollbarPolicy = showScrollbarToPolicy (options ^. lensShowScrollbar) scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy + -- | Show the preferences dialog. -- -- When the user clicks on the Ok button, it copies the new settings to TMState. diff --git a/src/Termonad/Lenses.hs b/src/Termonad/Lenses.hs index ca1b9f1..1287ca3 100644 --- a/src/Termonad/Lenses.hs +++ b/src/Termonad/Lenses.hs @@ -2,11 +2,14 @@ module Termonad.Lenses where -import Control.Lens (makeLensesFor, makePrisms) +import Termonad.Prelude + +import Control.Lens (Lens', Traversal', makeLensesFor, makePrisms) import Termonad.Types $(makeLensesFor - [ ("term", "lensTerm") + [ ("tmTermScrolledWindow", "lensTMTermScrolledWindow") + , ("term", "lensTerm") , ("pid", "lensPid") , ("unique", "lensUnique") ] @@ -15,13 +18,28 @@ $(makeLensesFor $(makeLensesFor [ ("tmNotebookTabPaned", "lensTMNotebookTabPaned") - , ("tmNotebookTabScrolledWindow", "lensTMNotebookTabScrolledWindow") - , ("tmNotebookTabTerm", "lensTMNotebookTabTerm") + , ("tmNotebookTabLeftTerm", "lensTMNotebookTabLeftTerm") + , ("tmNotebookTabRightTerm", "lensTMNotebookTabRightTerm") , ("tmNotebookTabLabel", "lensTMNotebookTabLabel") ] ''TMNotebookTab ) +lensTMNotebookTabFocusedTerm :: Lens' TMNotebookTab TMTerm +lensTMNotebookTabFocusedTerm f notebookTab + = if tmNotebookTabFocusIsOnLeft notebookTab + then lensTMNotebookTabLeftTerm f notebookTab + else lensTMNotebookTabRightTerm f notebookTab + +traversalTMNotebookTabTerms :: Traversal' TMNotebookTab TMTerm +traversalTMNotebookTabTerms f notebookTab + = (\termL termR -> notebookTab + { tmNotebookTabLeftTerm = termL + , tmNotebookTabRightTerm = termR + }) + <$> f (tmNotebookTabLeftTerm notebookTab) + <*> f (tmNotebookTabRightTerm notebookTab) + $(makeLensesFor [ ("tmNotebook", "lensTMNotebook") , ("tmNotebookTabs", "lensTMNotebookTabs") diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index fe05ff9..2dcaa92 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -105,9 +105,9 @@ import Termonad.Lenses , lensOptions , lensShowScrollbar , lensShowTabBar + , lensTMNotebookTabFocusedTerm , lensTMNotebookTabLabel , lensTMNotebookTabPaned - , lensTMNotebookTabTerm , lensTMNotebookTabs , lensTMStateApp , lensTMStateConfig @@ -131,7 +131,6 @@ import Termonad.Types , pid , tmNotebook , tmNotebookTabPaned - , tmNotebookTabTerm , tmNotebookTabs ) @@ -224,7 +223,7 @@ relabelTabs mvarTMState = do go notebook tmNotebookTab = do let label = tmNotebookTab ^. lensTMNotebookTabLabel paned = tmNotebookTab ^. lensTMNotebookTabPaned - term' = tmNotebookTab ^. lensTMNotebookTabTerm . lensTerm + term' = tmNotebookTab ^. lensTMNotebookTabFocusedTerm . lensTerm relabelTab notebook label paned term' -- | Compute the text for a 'Label' for a GTK Notebook tab. @@ -350,7 +349,7 @@ getCWDFromFocusedTab currNote = do case maybeFocusedTab of Nothing -> pure Nothing Just focusedNotebookTab -> do - let shellPid = pid (tmNotebookTabTerm focusedNotebookTab) + let shellPid = pid (focusedNotebookTab ^. lensTMNotebookTabFocusedTerm) cwdOfPid shellPid -- | Create the VTE 'Terminal', set the fonts and options @@ -443,76 +442,68 @@ createTerms handleKeyPress mvarTMState = do TMState{tmStateAppWin, tmStateFontDesc, tmStateConfig, tmStateNotebook=currNote} <- readMVar mvarTMState - -- Create a new terminal and launch a shell in it - vteTerm <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig) - tmTerm <- do - maybeCurrDir <- getCWDFromFocusedTab currNote - termShellPid <- launchShell vteTerm maybeCurrDir - newTMTerm vteTerm termShellPid - - -- Create the scrolling window container add the VTE term in it - scrolledWin <- createScrolledWin mvarTMState - containerAdd scrolledWin vteTerm - - -- Create a second terminal and launch a second shell in it - vteTerm2 <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig) - tmTerm2 <- do - maybeCurrDir <- getCWDFromFocusedTab currNote - termShellPid <- launchShell vteTerm2 maybeCurrDir - newTMTerm vteTerm termShellPid - - -- Create a second scrolling window container add the VTE term in it - scrolledWin2 <- createScrolledWin mvarTMState - containerAdd scrolledWin2 vteTerm2 - - -- Create the paned window container add the VTE term in it + -- Launch a shell in a Terminal in a ScrolledWindow + let createTerm :: IO (ScrolledWindow, Terminal, TMTerm) + createTerm = do + scrolledWin <- createScrolledWin mvarTMState + vteTerm <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig) + maybeCurrDir <- getCWDFromFocusedTab currNote + termShellPid <- launchShell vteTerm maybeCurrDir + tmTerm <- newTMTerm scrolledWin vteTerm termShellPid + containerAdd scrolledWin vteTerm + pure (scrolledWin, vteTerm, tmTerm) + + -- Create the left and right terminals + (scrolledWinR, vteTermR, tmTermR) <- createTerm + (scrolledWinL, vteTermL, tmTermL) <- createTerm + + -- Create the paned window container add the two terminals to it paned <- Gtk.panedNew OrientationHorizontal Gtk.panedSetWideHandle paned True - Gtk.panedPack1 paned scrolledWin True True - Gtk.panedPack2 paned scrolledWin2 True True + Gtk.panedPack1 paned scrolledWinL True True + Gtk.panedPack2 paned scrolledWinR True True Gtk.widgetShowAll paned -- Create the GTK widget for the Notebook tab (tabLabelBox, tabLabel, tabCloseButton) <- createNotebookTabLabel -- Create notebook state - let notebookTab = createTMNotebookTab tabLabel paned scrolledWin tmTerm + let notebookTab = createTMNotebookTab tabLabel paned tmTermL tmTermR -- Add the new notebooktab to the notebook. addPage mvarTMState notebookTab 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. There are two terminals and only one tab label, so we use - -- the first terminal's title. - -- TODO: use the most recently-focused terminal instead. - relabelTab (tmNotebook currNote) tabLabel paned vteTerm + -- appropriately. We use the left terminal's title because it is the left + -- terminal which initially has the focus. + relabelTab (tmNotebook currNote) tabLabel paned vteTermL -- Connect callbacks void $ onButtonClicked tabCloseButton $ termClose notebookTab mvarTMState - void $ onTerminalWindowTitleChanged vteTerm $ do + void $ onTerminalWindowTitleChanged vteTermL $ do + -- TODO: use the title of the focused pane TMState{tmStateNotebook} <- readMVar mvarTMState let notebook = tmNotebook tmStateNotebook - relabelTab notebook tabLabel paned vteTerm - void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState - void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState - void $ onWidgetButtonPressEvent vteTerm $ handleMousePress vteTerm - void $ onTerminalChildExited vteTerm $ \_ -> termExit notebookTab mvarTMState - void $ onWidgetKeyPressEvent vteTerm2 $ handleKeyPress mvarTMState - void $ onWidgetKeyPressEvent scrolledWin2 $ handleKeyPress mvarTMState - void $ onWidgetButtonPressEvent vteTerm2 $ handleMousePress vteTerm2 - void $ onTerminalChildExited vteTerm2 $ \_ -> termExit notebookTab mvarTMState - - -- Put the keyboard focus on the first term - setFocusOn tmStateAppWin vteTerm + relabelTab notebook tabLabel paned vteTermL + for_ @[Terminal] [vteTermL, vteTermR] $ \vteTerm -> do + void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState + void $ onWidgetButtonPressEvent vteTerm $ handleMousePress vteTerm + void $ onTerminalChildExited vteTerm $ \_ -> termExit notebookTab mvarTMState + for_ @[ScrolledWindow] [scrolledWinL, scrolledWinR] $ \scrolledWin -> do + void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState + + -- Put the keyboard focus on the left term + setFocusOn tmStateAppWin vteTermL -- Make sure the state is still right assertInvariantTMState mvarTMState -- Run user-defined hooks for modifying the newly-created VTE Terminals. - createTermHook (hooks tmStateConfig) mvarTMState vteTerm - createTermHook (hooks tmStateConfig) mvarTMState vteTerm2 - pure (tmTerm, tmTerm2) + for_ @[Terminal] [vteTermL, vteTermR] $ \vteTerm -> do + createTermHook (hooks tmStateConfig) mvarTMState vteTerm + + pure (tmTermL, tmTermR) -- | Popup the context menu on right click handleMousePress :: Terminal -> EventButton -> IO Bool diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 374265f..5d3c936 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -37,10 +37,13 @@ import Text.Show (ShowS, showParen, showString) import Termonad.Gtk (widgetEq) -- | A wrapper around a VTE 'Terminal'. This also stores the process ID of the --- process running on this terminal, as well as a 'Unique' that can be used for --- comparing terminals. +-- process running on this terminal, the 'Unique' that can be used for +-- comparing terminals, and the 'ScrolledWindow' which surrounds the +-- 'Terminal', allowing the user to scroll up to see the history. data TMTerm = TMTerm - { term :: !Terminal + { tmTermScrolledWindow :: !ScrolledWindow + -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'. + , term :: !Terminal -- ^ The actual 'Terminal'. , pid :: !Int -- ^ The process ID of the process running in 'term'. @@ -53,6 +56,9 @@ instance Show TMTerm where showsPrec d TMTerm{..} = showParen (d > 10) $ showString "TMTerm {" . + showString "tmTermScrolledWindow = " . + showString "(GI.GTK.ScrolledWindow)" . + showString ", " . showString "term = " . showString "(GI.GTK.Terminal)" . showString ", " . @@ -63,19 +69,21 @@ instance Show TMTerm where showsPrec (d + 1) (hashUnique unique) . showString "}" --- | A container that holds everything in a given notebook tab. The 'term' in --- the 'TMTerm' is inside the 'tmNotebookTabScrolledWindow' 'ScrolledWindow', --- which is in turn inside the 'tmNotebookTabPaned' 'Paned'. The notebook tab --- 'Label' is also available. +-- | A container that holds everything in a given notebook tab. Each tab is +-- split in two terminals, one on the left and one on the right. The notebook +-- tab 'Label' is also available. data TMNotebookTab = TMNotebookTab { tmNotebookTabPaned :: !Paned - -- ^ The 'Paned' holding the 'ScrolledWindow'. - , tmNotebookTabScrolledWindow :: !ScrolledWindow - -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'. - , tmNotebookTabTerm :: !TMTerm - -- ^ The 'Terminal' inside the 'ScrolledWindow'. + -- ^ The 'Paned' holding the two 'TMTerm's. + , tmNotebookTabLeftTerm :: !TMTerm + -- ^ The left 'TMTerm'. + , tmNotebookTabRightTerm :: !TMTerm + -- ^ The right 'TMTerm'. + , tmNotebookTabFocusIsOnLeft :: !Bool + -- ^ Whether it is the left 'TMTerm' which has the focus (if 'True') or the + -- right 'TMTerm' (if 'False'). , tmNotebookTabLabel :: !Label - -- ^ The 'Label' holding the title of the 'Terminal' in the 'Notebook' tab. + -- ^ The 'Label' holding the title of the left 'Terminal' in the 'Notebook' tab. } instance Show TMNotebookTab where @@ -86,11 +94,11 @@ instance Show TMNotebookTab where showString "tmNotebookTabPaned = " . showString "(GI.GTK.Paned)" . showString ", " . - showString "tmNotebookTabScrolledWindow = " . - showString "(GI.GTK.ScrolledWindow)" . + showString "tmNotebookTabLeftTerm = " . + showsPrec (d + 1) tmNotebookTabLeftTerm . showString ", " . - showString "tmNotebookTabTerm = " . - showsPrec (d + 1) tmNotebookTabTerm . + showString "tmNotebookTabRightTerm = " . + showsPrec (d + 1) tmNotebookTabRightTerm . showString ", " . showString "tmNotebookTabLabel = " . showString "(GI.GTK.Label)" . @@ -154,35 +162,41 @@ instance Eq TMTerm where instance Eq TMNotebookTab where (==) :: TMNotebookTab -> TMNotebookTab -> Bool - (==) = (==) `on` tmNotebookTabTerm + l == r = ((==) `on` tmNotebookTabLeftTerm) l r + && ((==) `on` tmNotebookTabRightTerm) l r -createTMTerm :: Terminal -> Int -> Unique -> TMTerm -createTMTerm trm pd unq = +createTMTerm :: ScrolledWindow -> Terminal -> Int -> Unique -> TMTerm +createTMTerm scrollWin trm pd unq = TMTerm - { term = trm + { tmTermScrolledWindow = scrollWin + , term = trm , pid = pd , unique = unq } -newTMTerm :: Terminal -> Int -> IO TMTerm -newTMTerm trm pd = createTMTerm trm pd <$> newUnique +newTMTerm :: ScrolledWindow -> Terminal -> Int -> IO TMTerm +newTMTerm scrollWin trm pd = createTMTerm scrollWin trm pd <$> newUnique getFocusedTermFromState :: TMState -> IO (Maybe Terminal) getFocusedTermFromState mvarTMState = - withMVar mvarTMState go + withMVar mvarTMState (pure . go) where - go :: TMState' -> IO (Maybe Terminal) + go :: TMState' -> Maybe Terminal go tmState = do - let maybeNotebookTab = - getFocusItemFL $ tmNotebookTabs $ tmStateNotebook tmState - pure $ fmap (term . tmNotebookTabTerm) maybeNotebookTab - -createTMNotebookTab :: Label -> Paned -> ScrolledWindow -> TMTerm -> TMNotebookTab -createTMNotebookTab tabLabel paned scrollWin trm = + notebookTab <- getFocusItemFL $ tmNotebookTabs $ tmStateNotebook tmState + let focusedTMTerm + = if tmNotebookTabFocusIsOnLeft notebookTab + then tmNotebookTabLeftTerm notebookTab + else tmNotebookTabRightTerm notebookTab + pure $ term focusedTMTerm + +createTMNotebookTab :: Label -> Paned -> TMTerm -> TMTerm -> TMNotebookTab +createTMNotebookTab tabLabel paned trmL trmR = TMNotebookTab { tmNotebookTabPaned = paned - , tmNotebookTabScrolledWindow = scrollWin - , tmNotebookTabTerm = trm + , tmNotebookTabLeftTerm = trmL + , tmNotebookTabRightTerm = trmR + , tmNotebookTabFocusIsOnLeft = True , tmNotebookTabLabel = tabLabel } @@ -228,7 +242,7 @@ newEmptyTMState tmConfig app appWin note fontDesc = , tmStateConfig = tmConfig } -newTMStateSingleTerm :: +newTMStateSingleTab :: TMConfig -> Application -> ApplicationWindow @@ -238,11 +252,15 @@ newTMStateSingleTerm :: -> ScrolledWindow -> Terminal -> Int + -> ScrolledWindow + -> Terminal + -> Int -> FontDescription -> IO TMState -newTMStateSingleTerm tmConfig app appWin note label paned scrollWin trm pd fontDesc = do - tmTerm <- newTMTerm trm pd - let tmNoteTab = createTMNotebookTab label paned scrollWin tmTerm +newTMStateSingleTab tmConfig app appWin note label paned scrollWinL trmL pdL scrollWinR trmR pdR fontDesc = do + tmTermL <- newTMTerm scrollWinL trmL pdL + tmTermR <- newTMTerm scrollWinR trmR pdR + let tmNoteTab = createTMNotebookTab label paned tmTermL tmTermR tabs = singletonFL tmNoteTab tmNote = createTMNotebook note tabs newTMState tmConfig app appWin tmNote fontDesc From 9c06b973eba9d6e282b1170fd88a140ac2dcd3c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Wed, 27 Oct 2021 22:33:22 -0400 Subject: [PATCH 16/19] hotkeys to navigate between panes Also, update the tmNotebookTabFocusIsOnLeft field to reflect the currently-focused pane. The (followUp <- do ...) pattern is needed in order to avoid a deadlock when the onWidgetFocusInEvent callback tries to grab the MVar which is already locked. --- src/Termonad/App.hs | 36 +++++++++++++++++++++++++++--------- src/Termonad/Lenses.hs | 32 ++++++++++++++++++++++++++++++++ src/Termonad/Term.hs | 25 +++++++++++++++++++++++++ 3 files changed, 84 insertions(+), 9 deletions(-) diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs index 8642c04..d357359 100644 --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -154,9 +154,10 @@ import Termonad.PreferencesFile (saveToPreferencesFile) import Termonad.Term ( createTerms , relabelTabs + , termExitFocused , termNextPage , termPrevPage - , termExitFocused + , termTogglePane , setShowTabs , showScrollbarToPolicy ) @@ -393,17 +394,22 @@ setupTermonad tmConfig app win builder = do else setShowTabs tmConfig note void $ onNotebookSwitchPage note $ \_ pageNum -> do - modifyMVar_ mvarTMState $ \tmState -> do + followUp <- modifyMVar mvarTMState $ \tmState -> do let notebook = tmStateNotebook tmState tabs = tmNotebookTabs notebook maybeNewTabs = updateFocusFL (fromIntegral pageNum) tabs case maybeNewTabs of - Nothing -> pure tmState + Nothing -> do + pure (tmState, pure ()) Just (tab, newTabs) -> do - widgetGrabFocus $ tab ^. lensTMNotebookTabFocusedTerm . lensTerm - pure $ - tmState & - lensTMStateNotebook . lensTMNotebookTabs .~ newTabs + let followUp = do + let newFocus = tab ^. lensTMNotebookTabFocusedTerm . lensTerm + widgetGrabFocus newFocus + tmState' + = tmState + & lensTMStateNotebook . lensTMNotebookTabs .~ newTabs + pure (tmState', followUp) + followUp void $ onNotebookPageReordered note $ \childWidg pageNum -> do maybePaned <- castTo Paned childWidg @@ -433,17 +439,29 @@ setupTermonad tmConfig app win builder = do actionMapAddAction app newTabAction applicationSetAccelsForAction app "app.newtab" ["T"] + nextPaneAction <- simpleActionNew "nextpane" Nothing + void $ onSimpleActionActivate nextPaneAction $ \_ -> + termTogglePane mvarTMState + actionMapAddAction app nextPaneAction + applicationSetAccelsForAction app "app.nextpane" ["Page_Down"] + + prevPaneAction <- simpleActionNew "prevpane" Nothing + void $ onSimpleActionActivate prevPaneAction $ \_ -> + termTogglePane mvarTMState + actionMapAddAction app prevPaneAction + applicationSetAccelsForAction app "app.prevpane" ["Page_Up"] + nextPageAction <- simpleActionNew "nextpage" Nothing void $ onSimpleActionActivate nextPageAction $ \_ -> termNextPage mvarTMState actionMapAddAction app nextPageAction - applicationSetAccelsForAction app "app.nextpage" ["Page_Down"] + applicationSetAccelsForAction app "app.nextpage" ["Page_Down"] prevPageAction <- simpleActionNew "prevpage" Nothing void $ onSimpleActionActivate prevPageAction $ \_ -> termPrevPage mvarTMState actionMapAddAction app prevPageAction - applicationSetAccelsForAction app "app.prevpage" ["Page_Up"] + applicationSetAccelsForAction app "app.prevpage" ["Page_Up"] closeTabAction <- simpleActionNew "closetab" Nothing void $ onSimpleActionActivate closeTabAction $ \_ -> diff --git a/src/Termonad/Lenses.hs b/src/Termonad/Lenses.hs index 1287ca3..e368134 100644 --- a/src/Termonad/Lenses.hs +++ b/src/Termonad/Lenses.hs @@ -5,7 +5,11 @@ module Termonad.Lenses where import Termonad.Prelude import Control.Lens (Lens', Traversal', makeLensesFor, makePrisms) +import Data.FocusList (FocusList) import Termonad.Types +import qualified Data.FocusList as FocusList +import qualified Data.Maybe as Unsafe (fromJust) +import qualified Data.Sequence as Seq $(makeLensesFor [ ("tmTermScrolledWindow", "lensTMTermScrolledWindow") @@ -20,6 +24,7 @@ $(makeLensesFor [ ("tmNotebookTabPaned", "lensTMNotebookTabPaned") , ("tmNotebookTabLeftTerm", "lensTMNotebookTabLeftTerm") , ("tmNotebookTabRightTerm", "lensTMNotebookTabRightTerm") + , ("tmNotebookTabFocusIsOnLeft", "lensTMNotebookTabFocusIsOnLeft") , ("tmNotebookTabLabel", "lensTMNotebookTabLabel") ] ''TMNotebookTab @@ -31,6 +36,12 @@ lensTMNotebookTabFocusedTerm f notebookTab then lensTMNotebookTabLeftTerm f notebookTab else lensTMNotebookTabRightTerm f notebookTab +lensTMNotebookTabNonFocusedTerm :: Lens' TMNotebookTab TMTerm +lensTMNotebookTabNonFocusedTerm f notebookTab + = if tmNotebookTabFocusIsOnLeft notebookTab + then lensTMNotebookTabRightTerm f notebookTab + else lensTMNotebookTabLeftTerm f notebookTab + traversalTMNotebookTabTerms :: Traversal' TMNotebookTab TMTerm traversalTMNotebookTabTerms f notebookTab = (\termL termR -> notebookTab @@ -47,6 +58,27 @@ $(makeLensesFor ''TMNotebook ) +-- TODO: upstream this to the focuslist package +traversalFLItem :: forall a. Traversal' (FocusList a) a +traversalFLItem f flA + = let seqA = FocusList.toSeqFL flA + maybeFocus = FocusList.getFocus (FocusList.getFocusFL flA) + maybeFocusItem = FocusList.getFocusItemFL flA + in case (maybeFocus, maybeFocusItem) of + (Just i, Just a) + -> let makeUpdatedFL :: a -> FocusList a + makeUpdatedFL a' + = Unsafe.fromJust -- safe because i and the length are unchanged + $ FocusList.fromFoldableFL + (FocusList.Focus i) + (Seq.update i a' seqA) + in makeUpdatedFL <$> f a + _ + -> pure flA + +traversalTMNotebookFocusedTab :: Traversal' TMNotebook TMNotebookTab +traversalTMNotebookFocusedTab = lensTMNotebookTabs . traversalFLItem + $(makeLensesFor [ ("tmStateApp", "lensTMStateApp") , ("tmStateAppWin", "lensTMStateAppWin") diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs index 2dcaa92..bfa815d 100644 --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -68,6 +68,7 @@ import GI.Gtk , notebookSetTabReorderable , onButtonClicked , onWidgetButtonPressEvent + , onWidgetFocusInEvent , onWidgetKeyPressEvent , scrolledWindowNew , scrolledWindowSetPolicy @@ -106,13 +107,16 @@ import Termonad.Lenses , lensShowScrollbar , lensShowTabBar , lensTMNotebookTabFocusedTerm + , lensTMNotebookTabFocusIsOnLeft , lensTMNotebookTabLabel + , lensTMNotebookTabNonFocusedTerm , lensTMNotebookTabPaned , lensTMNotebookTabs , lensTMStateApp , lensTMStateConfig , lensTMStateNotebook , lensTerm + , traversalTMNotebookFocusedTab ) import Termonad.Types ( ConfigHooks(createTermHook) @@ -142,6 +146,14 @@ focusTerm i mvarTMState = do altNumSwitchTerm :: Int -> TMState -> IO () altNumSwitchTerm = focusTerm +termTogglePane :: TMState -> IO () +termTogglePane mvarTMState = do + tabs <- tmNotebookTabs . tmStateNotebook <$> readMVar mvarTMState + let maybeFocusedTab = getFocusItemFL tabs + for_ maybeFocusedTab $ \focusedTab -> do + let newFocus = focusedTab ^. lensTMNotebookTabNonFocusedTerm . lensTerm + widgetGrabFocus newFocus + termNextPage :: TMState -> IO () termNextPage mvarTMState = do note <- tmNotebook . tmStateNotebook <$> readMVar mvarTMState @@ -493,6 +505,19 @@ createTerms handleKeyPress mvarTMState = do for_ @[ScrolledWindow] [scrolledWinL, scrolledWinR] $ \scrolledWin -> do void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState + void $ onWidgetFocusInEvent vteTermL $ \_ -> do + modifyMVar_ mvarTMState $ \tmState -> do + pure $ tmState & lensTMStateNotebook + . traversalTMNotebookFocusedTab + . lensTMNotebookTabFocusIsOnLeft .~ True + pure False + void $ onWidgetFocusInEvent vteTermR $ \_ -> do + modifyMVar_ mvarTMState $ \tmState -> do + pure $ tmState & lensTMStateNotebook + . traversalTMNotebookFocusedTab + . lensTMNotebookTabFocusIsOnLeft .~ False + pure False + -- Put the keyboard focus on the left term setFocusOn tmStateAppWin vteTermL From bbcd3fae01915e851d2dd78582fc5646e22dc277 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Mon, 3 Jan 2022 21:54:14 -0500 Subject: [PATCH 17/19] update comment to reflect focuslist-0.1.1.0 release --- src/Termonad/Lenses.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Termonad/Lenses.hs b/src/Termonad/Lenses.hs index e368134..99b30c7 100644 --- a/src/Termonad/Lenses.hs +++ b/src/Termonad/Lenses.hs @@ -58,7 +58,9 @@ $(makeLensesFor ''TMNotebook ) --- TODO: upstream this to the focuslist package +-- TODO: This should be available in focuslist-0.1.1.0 as traversalFocusItem. +-- focuslist-0.1.1.0 should likely be available in LTS-19. +-- We should delete this function and use traversalFocusItem when Termonad moves to using LTS-19. traversalFLItem :: forall a. Traversal' (FocusList a) a traversalFLItem f flA = let seqA = FocusList.toSeqFL flA From 6dd0c158347632cbaad5914729e3681f6cd175c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 16 Jan 2022 12:54:41 -0500 Subject: [PATCH 18/19] move printWidgetTree to Termonad.Gtk --- src/Termonad/Gtk.hs | 18 ++++++++++++++++++ src/Termonad/Types.hs | 19 ------------------- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/src/Termonad/Gtk.hs b/src/Termonad/Gtk.hs index af3bc1e..1ca3c6e 100644 --- a/src/Termonad/Gtk.hs +++ b/src/Termonad/Gtk.hs @@ -6,6 +6,7 @@ import Termonad.Prelude import Control.Monad.Fail (MonadFail, fail) import Data.GI.Base (ManagedPtr, withManagedPtr) +import Data.GI.Base.GObject (gtypeFromInstance) import GHC.Stack (HasCallStack) import GI.Gdk ( GObject @@ -60,3 +61,20 @@ widgetEq a b = do withManagedPtr managedPtrA $ \ptrA -> withManagedPtr managedPtrB $ \ptrB -> pure (ptrA == ptrB) + +printWidgetTree :: Gtk.IsWidget a => a -> IO () +printWidgetTree widget_ = do + widget <- Gtk.toWidget widget_ + go "" widget + where + go :: Text -> Gtk.Widget -> IO () + go indent w = do + type_ <- gtypeFromInstance w + name <- Gtk.gtypeName type_ + let ptr = Gtk.managedForeignPtr . Gtk.toManagedPtr $ w + putStrLn $ indent <> pack name <> " " <> pack (show ptr) + maybeContainer <- Gtk.castTo Gtk.Container w + for_ maybeContainer $ \container -> do + children <- Gtk.containerGetChildren container + for_ children $ \child -> do + go (" " <> indent) child diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs index 5d3c936..905c7b4 100644 --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -27,8 +27,6 @@ import GI.Gtk , notebookGetNthPage , notebookGetNPages ) -import qualified GI.Gtk as Gtk -import Data.GI.Base.GObject import GI.Pango (FontDescription) import GI.Vte (Terminal, CursorBlinkMode(..)) import Text.Pretty.Simple (pPrint) @@ -560,23 +558,6 @@ data TMStateInvariantErr | TabsDoNotMatch TabsDoNotMatch deriving Show -printWidgetTree :: Gtk.IsWidget a => a -> IO () -printWidgetTree widget_ = do - widget <- Gtk.toWidget widget_ - go "" widget - where - go :: Text -> Gtk.Widget -> IO () - go indent w = do - type_ <- gtypeFromInstance w - name <- Gtk.gtypeName type_ - let ptr = Gtk.managedForeignPtr . Gtk.toManagedPtr $ w - putStrLn $ indent <> pack name <> " " <> pack (show ptr) - maybeContainer <- Gtk.castTo Gtk.Container w - for_ maybeContainer $ \container -> do - children <- Gtk.containerGetChildren container - for_ children $ \child -> do - go (" " <> indent) child - -- | Gather up the invariants for 'TMState' and return them as a list. -- -- If no invariants have been violated, then this function should return an From 9568b687ffa84475cea5ab467b6fdcc517f6cda6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Samuel=20G=C3=A9lineau?= Date: Sun, 16 Jan 2022 13:29:36 -0500 Subject: [PATCH 19/19] adding myself as a co-maintainer --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index b907df8..3cc3544 100644 --- a/README.md +++ b/README.md @@ -519,3 +519,4 @@ would like to add, please submit an issue or PR. ## Maintainers - [cdepillabout](https://github.com/cdepillabout) +- [gelisam](https://github.com/gelisam)