Split every tab in two panes

README.md

@@ -529,3 +529,4 @@ would like to add, please submit an issue or PR.
 ## Maintainers
 
 - [cdepillabout](https://github.com/cdepillabout)
+- [gelisam](https://github.com/gelisam)

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
@@ -138,24 +138,26 @@ import Termonad.Lenses
   , lensShowTabBar
   , lensScrollbackLen
   , lensTMNotebook
-  , lensTMNotebookTabTermContainer
+  , lensTMNotebookTabFocusedTerm
   , lensTMNotebookTabs
-  , lensTMNotebookTabTerm
   , lensTMStateApp
   , lensTMStateAppWin
   , lensTMStateConfig
   , lensTMStateFontDesc
   , lensTMStateNotebook
+  , lensTMTermScrolledWindow
   , lensTerm
   , lensWordCharExceptions
+  , traversalTMNotebookTabTerms
   )
 import Termonad.PreferencesFile (saveToPreferencesFile)
 import Termonad.Term
-  ( createTerm
+  ( createTerms
   , relabelTabs
+  , termExitFocused
   , termNextPage
   , termPrevPage
-  , termExitFocused
+  , termTogglePane
   , setShowTabs
   , showScrollbarToPolicy
   )
@@ -169,11 +171,12 @@ import Termonad.Types
   , TMNotebookTab
   , TMState
   , TMState'(TMState)
+  , TMTerm
   , getFocusedTermFromState
   , modFontSize
   , newEmptyTMState
-  , tmNotebookTabTermContainer
   , tmNotebookTabs
+  , tmNotebookTabPaned
   , tmStateApp
   , tmStateNotebook
   )
@@ -257,7 +260,7 @@ modifyFontSizeForAllTerms modFontSizeFunc mvarTMState = do
           lensTMStateNotebook .
           lensTMNotebookTabs .
           traverse .
-          lensTMNotebookTabTerm .
+          traversalTMNotebookTabTerms .
           lensTerm
   foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms
 
@@ -277,13 +280,13 @@ fontConfigFromFontDescription fontDescription = do
   maybeFontFamily <- fontDescriptionGetFamily fontDescription
   return $ (`FontConfig` fontSize) <$> maybeFontFamily
 
-compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool
-compareScrolledWinAndTab scrollWin flTab =
-  let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer 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 =
@@ -382,7 +385,7 @@ setupTermonad tmConfig app win builder = do
   boxPackStart box note True True 0
 
   mvarTMState <- newEmptyTMState tmConfig app win note fontDesc
-  terminal <- createTerm handleKeyPress mvarTMState
+  (terminalL, _terminalR) <- createTerms handleKeyPress mvarTMState
 
   void $ onNotebookPageRemoved note $ \_ _ -> do
     pages <- notebookGetNPages note
@@ -391,57 +394,74 @@ 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 ^. lensTMNotebookTabTerm . 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
-    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)
             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" ["<Shift><Ctrl>T"]
 
+  nextPaneAction <- simpleActionNew "nextpane" Nothing
+  void $ onSimpleActionActivate nextPaneAction $ \_ ->
+    termTogglePane mvarTMState
+  actionMapAddAction app nextPaneAction
+  applicationSetAccelsForAction app "app.nextpane" ["<Ctrl>Page_Down"]
+
+  prevPaneAction <- simpleActionNew "prevpane" Nothing
+  void $ onSimpleActionActivate prevPaneAction $ \_ ->
+    termTogglePane mvarTMState
+  actionMapAddAction app prevPaneAction
+  applicationSetAccelsForAction app "app.prevpane" ["<Ctrl>Page_Up"]
+
   nextPageAction <- simpleActionNew "nextpage" Nothing
   void $ onSimpleActionActivate nextPageAction $ \_ ->
     termNextPage mvarTMState
   actionMapAddAction app nextPageAction
-  applicationSetAccelsForAction app "app.nextpage" ["<Ctrl>Page_Down"]
+  applicationSetAccelsForAction app "app.nextpage" ["<Ctrl><Shift>Page_Down"]
 
   prevPageAction <- simpleActionNew "prevpage" Nothing
   void $ onSimpleActionActivate prevPageAction $ \_ ->
     termPrevPage mvarTMState
   actionMapAddAction app prevPageAction
-  applicationSetAccelsForAction app "app.prevpage" ["<Ctrl>Page_Up"]
+  applicationSetAccelsForAction app "app.prevpage" ["<Ctrl><Shift>Page_Up"]
 
   closeTabAction <- simpleActionNew "closetab" Nothing
   void $ onSimpleActionActivate closeTabAction $ \_ ->
@@ -478,13 +498,13 @@ setupTermonad tmConfig app win builder = do
   void $ onSimpleActionActivate enlargeFontAction $ \_ ->
     modifyFontSizeForAllTerms (modFontSize 1) mvarTMState
   actionMapAddAction app enlargeFontAction
-  applicationSetAccelsForAction app "app.enlargefont" ["<Ctrl>plus"]
+  applicationSetAccelsForAction app "app.enlargefont" ["<Ctrl>KP_Add"]
 
   reduceFontAction <- simpleActionNew "reducefont" Nothing
   void $ onSimpleActionActivate reduceFontAction $ \_ ->
     modifyFontSizeForAllTerms (modFontSize (-1)) mvarTMState
   actionMapAddAction app reduceFontAction
-  applicationSetAccelsForAction app "app.reducefont" ["<Ctrl>minus"]
+  applicationSetAccelsForAction app "app.reducefont" ["<Ctrl>KP_Subtract"]
 
   findAction <- simpleActionNew "find" Nothing
   void $ onSimpleActionActivate findAction $ \_ -> doFind mvarTMState
@@ -528,8 +548,9 @@ setupTermonad tmConfig app win builder = do
         ResponseTypeYes -> False
         _ -> True
 
+  -- Focus on the left terminal
   widgetShowAll win
-  widgetGrabFocus $ terminal ^. lensTerm
+  widgetGrabFocus $ terminalL ^. lensTerm
 
 appActivate :: TMConfig -> Application -> IO ()
 appActivate tmConfig app = do
@@ -717,10 +738,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 ^. lensTMNotebookTabTermContainer
+      term = tmTerm ^. lensTerm
+      scrolledWin = tmTerm ^. lensTMTermScrolledWindow
       options = tmState ^. lensTMStateConfig . lensOptions
   terminalSetFont term (Just fontDesc)
   terminalSetCursorBlinkMode term (cursorBlinkMode options)
@@ -731,6 +757,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.

src/Termonad/Gtk.hs

@@ -4,6 +4,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
@@ -58,3 +59,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

src/Termonad/Lenses.hs

@@ -2,32 +2,85 @@
 
 module Termonad.Lenses where
 
-import Control.Lens (makeLensesFor, makePrisms)
+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
-    [ ("term", "lensTerm")
+    [ ("tmTermScrolledWindow", "lensTMTermScrolledWindow")
+    , ("term", "lensTerm")
     , ("pid", "lensPid")
     , ("unique", "lensUnique")
     ]
     ''TMTerm
  )
 
 $(makeLensesFor
-    [ ("tmNotebookTabTermContainer", "lensTMNotebookTabTermContainer")
-    , ("tmNotebookTabTerm", "lensTMNotebookTabTerm")
+    [ ("tmNotebookTabPaned", "lensTMNotebookTabPaned")
+    , ("tmNotebookTabLeftTerm", "lensTMNotebookTabLeftTerm")
+    , ("tmNotebookTabRightTerm", "lensTMNotebookTabRightTerm")
+    , ("tmNotebookTabFocusIsOnLeft", "lensTMNotebookTabFocusIsOnLeft")
     , ("tmNotebookTabLabel", "lensTMNotebookTabLabel")
     ]
     ''TMNotebookTab
  )
 
+lensTMNotebookTabFocusedTerm :: Lens' TMNotebookTab TMTerm
+lensTMNotebookTabFocusedTerm f notebookTab
+  = if tmNotebookTabFocusIsOnLeft 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
+                         { tmNotebookTabLeftTerm = termL
+                         , tmNotebookTabRightTerm = termR
+                         })
+  <$> f (tmNotebookTabLeftTerm notebookTab)
+  <*> f (tmNotebookTabRightTerm notebookTab)
+
 $(makeLensesFor
     [ ("tmNotebook", "lensTMNotebook")
     , ("tmNotebookTabs", "lensTMNotebookTabs")
     ]
     ''TMNotebook
  )
 
+-- 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
+        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")