content: 
  module Termonad.Window where
  
  import Termonad.Prelude
  
  import Control.Lens ((^.), (^..), set, view, ix)
  import Data.FocusList (focusList, moveFromToFL, updateFocusFL)
  import Data.Sequence (findIndexR)
  import qualified Data.Text as Text
  import GI.Gdk (castTo, managedForeignPtr)
  import GI.Gio
    ( actionMapAddAction
    , onSimpleActionActivate
    , simpleActionNew
    )
  import GI.Gtk
    ( Application
    , ApplicationWindow
    , Notebook
    , PositionType(PositionTypeRight)
    , ResponseType(ResponseTypeNo, ResponseTypeYes)
    , ScrolledWindow(ScrolledWindow)
    , Widget
    , aboutDialogNew
    , applicationSetAccelsForAction
    , containerAdd
    , dialogAddButton
    , dialogGetContentArea
    , dialogNew
    , dialogResponse
    , dialogRun
    , entryGetText
    , entryNew
    , gridAttachNextTo
    , gridNew
    , labelNew
    , onEntryActivate
    , onNotebookPageReordered
    , onNotebookSwitchPage
    , setWidgetMargin
    , widgetDestroy
    , widgetGrabFocus
    , widgetShow
    , windowSetTransientFor
    )
  import GI.Pango (FontDescription)
  import GI.Vte
    ( catchRegexError
    , regexNewForSearch
    , terminalCopyClipboard
    , terminalPasteClipboard
    , terminalSearchFindNext
    , terminalSearchFindPrevious
    , terminalSearchSetRegex
    , terminalSearchSetWrapAround
    , terminalSetFont
    )
  import Termonad.Keys (handleKeyPress)
  import Termonad.Lenses
    ( lensTMNotebookTabs
    , lensTMNotebookTabTerm
    , lensTMStateFontDesc
    , lensTerm
    , lensTMStateWindows
    , lensTMWindowNotebook
    )
  import Termonad.Term
    ( createTerm
    , relabelTabs
    , termNextPage
    , termPrevPage
    , termExitFocused
    )
  import Termonad.Types
    ( FontSize
    , TMNotebookTab
    , TMState
    , TMWindowId
    , fontSizeFromFontDescription
    , getFocusedTermFromState
    , getTMNotebookFromTMState
    , getTMNotebookFromTMState'
    , getTMWindowFromTMState
    , setFontDescSize
    , tmNotebookTabTermContainer
    , tmNotebookTabs
    , tmWindowAppWin
    )
  
  modifyFontSizeForAllTerms :: (FontSize -> FontSize) -> TMState -> TMWindowId -> IO ()
  modifyFontSizeForAllTerms modFontSizeFunc mvarTMState tmWinId = do
    tmState <- readMVar mvarTMState
    let fontDesc = tmState ^. lensTMStateFontDesc
    adjustFontDescSize modFontSizeFunc fontDesc
    let terms =
          tmState ^..
            lensTMStateWindows .
            ix tmWinId .
            lensTMWindowNotebook .
            lensTMNotebookTabs .
            traverse .
            lensTMNotebookTabTerm .
            lensTerm
    foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms
    where
      adjustFontDescSize :: (FontSize -> FontSize) -> FontDescription -> IO ()
      adjustFontDescSize f fontDesc = do
        currFontSz <- fontSizeFromFontDescription fontDesc
        let newFontSz = f currFontSz
        setFontDescSize fontDesc newFontSz
  
  -- | This is the callback for when a page in a 'Notebook' has been reordered
  -- (normally caused by a drag-and-drop event).
  notebookPageReorderedCallback
    :: TMState
    -> TMWindowId
    -> Widget
    -- ^ The child widget that is in the Notebook page.
    -> Word32
    -- ^ The new index of the Notebook page.
    -> IO ()
  notebookPageReorderedCallback mvarTMState tmWinId childWidg pageNum = do
    maybeScrollWin <- castTo ScrolledWindow childWidg
    case maybeScrollWin of
      Nothing ->
        fail $
          "In setupTermonad, in callback for onNotebookPageReordered, " <>
          "child widget is not a ScrolledWindow.\n" <>
          "Don't know how to continue.\n"
      Just scrollWin -> do
        tmNote <- getTMNotebookFromTMState mvarTMState tmWinId
        let fl = view lensTMNotebookTabs tmNote
        let maybeOldPosition =
              findIndexR (compareScrolledWinAndTab scrollWin) (focusList fl)
        case maybeOldPosition of
          Nothing ->
            fail $
              "In setupTermonad, in callback for onNotebookPageReordered, " <>
              "the ScrolledWindow is not already in the FocusList.\n" <>
              "Don't know how to continue.\n"
          Just oldPos -> do
            updateFLTabPos mvarTMState tmWinId oldPos (fromIntegral pageNum)
            tmNote' <- getTMNotebookFromTMState mvarTMState tmWinId
            relabelTabs tmNote'
    where
      compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool
      compareScrolledWinAndTab scrollWin flTab =
        let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer flTab
            foreignPtrFLTab = managedForeignPtr managedPtrFLTab
            ScrolledWindow managedPtrScrollWin = scrollWin
            foreignPtrScrollWin = managedForeignPtr managedPtrScrollWin
        in foreignPtrFLTab == foreignPtrScrollWin
  
  -- | Move a 'TMNotebookTab' from one position to another.
  --
  -- If the current position index is out of bounds, or the new index is out of
  -- bounds, then nothing will be done.
  --
  -- Note that this function doesn't change anything about the 'tmNotebook'.
  -- This function is meant to be used as a call-back for when a 'Notebook's
  -- tab-order has been changed.
  updateFLTabPos
    :: TMState
    -> TMWindowId
    -> Int
    -- ^ Current position index.
    -> Int
    -- ^ New position index.
    -> IO ()
  updateFLTabPos mvarTMState tmWinId oldPos newPos =
    modifyMVar_ mvarTMState $ \tmState -> do
      note <- getTMNotebookFromTMState' tmState tmWinId
      let tabs = tmNotebookTabs note
          maybeNewTabs = moveFromToFL oldPos newPos tabs
      case maybeNewTabs of
        Nothing -> do
          putStrLn $
            "in updateFLTabPos, Strange error: couldn't move tabs.\n" <>
            "old pos: " <> show oldPos <> "\n" <>
            "new pos: " <> show newPos <> "\n" <>
            "tabs: " <> show tabs <> "\n" <>
            "maybeNewTabs: " <> show maybeNewTabs <> "\n" <>
            "tmState: " <> show tmState
          pure tmState
        Just newTabs ->
          pure $
            set
              (lensTMStateWindows . ix tmWinId . lensTMWindowNotebook . lensTMNotebookTabs)
              newTabs
              tmState
  
  showAboutDialog :: ApplicationWindow -> IO ()
  showAboutDialog win = do
    aboutDialog <- aboutDialogNew
    windowSetTransientFor aboutDialog (Just win)
    void $ dialogRun aboutDialog
    widgetDestroy aboutDialog
  
  showFindDialog :: ApplicationWindow -> IO (Maybe Text)
  showFindDialog win = do
    dialog <- dialogNew
    box <- dialogGetContentArea dialog
    grid <- gridNew
  
    searchForLabel <- labelNew (Just "Search for regex:")
    containerAdd grid searchForLabel
    widgetShow searchForLabel
    setWidgetMargin searchForLabel 10
  
    searchEntry <- entryNew
    gridAttachNextTo grid searchEntry (Just searchForLabel) PositionTypeRight 1 1
    widgetShow searchEntry
    setWidgetMargin searchEntry 10
    -- setWidgetMarginBottom searchEntry 20
    void $
      onEntryActivate searchEntry $
        dialogResponse dialog (fromIntegral (fromEnum ResponseTypeYes))
  
    void $
      dialogAddButton
        dialog
        "Close"
        (fromIntegral (fromEnum ResponseTypeNo))
    void $
      dialogAddButton
        dialog
        "Find"
        (fromIntegral (fromEnum ResponseTypeYes))
  
    containerAdd box grid
    widgetShow grid
    windowSetTransientFor dialog (Just win)
    res <- dialogRun dialog
  
    searchString <- entryGetText searchEntry
    let maybeSearchString =
          case toEnum (fromIntegral res) of
            ResponseTypeYes -> Just searchString
            _ -> Nothing
  
    widgetDestroy dialog
  
    pure maybeSearchString
  
  doFind :: TMState -> TMWindowId -> IO ()
  doFind mvarTMState tmWinId = do
    tmWin <- getTMWindowFromTMState mvarTMState tmWinId
    let win = tmWindowAppWin tmWin
    maybeSearchString <- showFindDialog win
    -- putStrLn $ "trying to find: " <> tshow maybeSearchString
    maybeTerminal <- getFocusedTermFromState mvarTMState tmWinId
    case (maybeSearchString, maybeTerminal) of
      (Just searchString, Just terminal) -> do
        -- TODO: Figure out how to import the correct pcre flags.
        --
        -- If you don't pass the pcre2Multiline flag, VTE gives
        -- the following warning:
        --
        -- (termonad-linux-x86_64:18792): Vte-WARNING **:
        -- 21:56:31.193: (vtegtk.cc:2269):void
        -- vte_terminal_search_set_regex(VteTerminal*,
        -- VteRegex*, guint32): runtime check failed:
        -- (regex == nullptr ||
        -- _vte_regex_get_compile_flags(regex) & PCRE2_MULTILINE)
        --
        -- However, if you do add the pcre2Multiline flag,
        -- the terminalSearchSetRegex appears to just completely
        -- not work.
        let pcreFlags = 0
        let newRegex =
              regexNewForSearch
                searchString
                (fromIntegral $ Text.length searchString)
                pcreFlags
        eitherRegex <-
          catchRegexError
            (fmap Right newRegex)
            (\_ errMsg -> pure (Left errMsg))
        case eitherRegex of
          Left errMsg -> do
            let msg = "error when creating regex: " <> errMsg
            hPutStrLn stderr msg
          Right regex -> do
            terminalSearchSetRegex terminal (Just regex) pcreFlags
            terminalSearchSetWrapAround terminal True
            _matchFound <- terminalSearchFindPrevious terminal
            -- TODO: Setup an actual logging framework to show these
            -- kinds of log messages.  Also make a similar change in
            -- findAbove and findBelow.
            -- putStrLn $ "was match found: " <> tshow matchFound
            pure ()
      _ -> pure ()
  
  findAbove :: TMState -> TMWindowId -> IO ()
  findAbove mvarTMState tmWinId = do
    maybeTerminal <- getFocusedTermFromState mvarTMState tmWinId
    case maybeTerminal of
      Nothing -> pure ()
      Just terminal -> do
        _matchFound <- terminalSearchFindPrevious terminal
        -- putStrLn $ "was match found: " <> tshow matchFound
        pure ()
  
  findBelow :: TMState -> TMWindowId -> IO ()
  findBelow mvarTMState tmWinId = do
    maybeTerminal <- getFocusedTermFromState mvarTMState tmWinId
    case maybeTerminal of
      Nothing -> pure ()
      Just terminal -> do
        _matchFound <- terminalSearchFindNext terminal
        -- putStrLn $ "was match found: " <> tshow matchFound
        pure ()
  
  setupWindowCallbacks :: TMState -> Application -> ApplicationWindow -> Notebook -> TMWindowId -> IO ()
  setupWindowCallbacks mvarTMState app win note tmWinId = do
  
    void $ onNotebookSwitchPage note $ \_ pageNum -> do
      modifyMVar_ mvarTMState $ \tmState -> do
        tmNote <- getTMNotebookFromTMState' tmState tmWinId
        let tabs = tmNotebookTabs tmNote
            maybeNewTabs = updateFocusFL (fromIntegral pageNum) tabs
        case maybeNewTabs of
          Nothing -> pure tmState
          Just (tab, newTabs) -> do
            widgetGrabFocus $ tab ^. lensTMNotebookTabTerm . lensTerm
            pure $
              set
                (lensTMStateWindows . ix tmWinId . lensTMWindowNotebook . lensTMNotebookTabs)
                newTabs
                tmState
  
    void $ onNotebookPageReordered note $ \childWidg pageNum ->
      notebookPageReorderedCallback mvarTMState tmWinId childWidg pageNum
  
    newTabAction <- simpleActionNew "newtab" Nothing
    void $ onSimpleActionActivate newTabAction $ \_ ->
      void $ createTerm handleKeyPress mvarTMState tmWinId
    actionMapAddAction win newTabAction
    applicationSetAccelsForAction app "win.newtab" ["<Shift><Ctrl>T"]
  
    nextPageAction <- simpleActionNew "nextpage" Nothing
    void $ onSimpleActionActivate nextPageAction $ \_ ->
      termNextPage mvarTMState tmWinId
    actionMapAddAction win nextPageAction
    applicationSetAccelsForAction app "win.nextpage" ["<Ctrl>Page_Down"]
  
    prevPageAction <- simpleActionNew "prevpage" Nothing
    void $ onSimpleActionActivate prevPageAction $ \_ ->
      termPrevPage mvarTMState tmWinId
    actionMapAddAction win prevPageAction
    applicationSetAccelsForAction app "win.prevpage" ["<Ctrl>Page_Up"]
  
    closeTabAction <- simpleActionNew "closetab" Nothing
    void $ onSimpleActionActivate closeTabAction $ \_ ->
      termExitFocused mvarTMState tmWinId
    actionMapAddAction win closeTabAction
    applicationSetAccelsForAction app "win.closetab" ["<Shift><Ctrl>W"]
  
    copyAction <- simpleActionNew "copy" Nothing
    void $ onSimpleActionActivate copyAction $ \_ -> do
      maybeTerm <- getFocusedTermFromState mvarTMState tmWinId
      maybe (pure ()) terminalCopyClipboard maybeTerm
    actionMapAddAction win copyAction
    applicationSetAccelsForAction app "win.copy" ["<Shift><Ctrl>C"]
  
    pasteAction <- simpleActionNew "paste" Nothing
    void $ onSimpleActionActivate pasteAction $ \_ -> do
      maybeTerm <- getFocusedTermFromState mvarTMState tmWinId
      maybe (pure ()) terminalPasteClipboard maybeTerm
    actionMapAddAction win pasteAction
    applicationSetAccelsForAction app "win.paste" ["<Shift><Ctrl>V"]
  
    findAction <- simpleActionNew "find" Nothing
    void $ onSimpleActionActivate findAction $ \_ -> doFind mvarTMState tmWinId
    actionMapAddAction win findAction
    applicationSetAccelsForAction app "win.find" ["<Shift><Ctrl>F"]
  
    findAboveAction <- simpleActionNew "findabove" Nothing
    void $ onSimpleActionActivate findAboveAction $ \_ -> findAbove mvarTMState tmWinId
    actionMapAddAction win findAboveAction
    applicationSetAccelsForAction app "win.findabove" ["<Shift><Ctrl>P"]
  
    findBelowAction <- simpleActionNew "findbelow" Nothing
    void $ onSimpleActionActivate findBelowAction $ \_ -> findBelow mvarTMState tmWinId
    actionMapAddAction win findBelowAction
    applicationSetAccelsForAction app "win.findbelow" ["<Shift><Ctrl>I"]
  