content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TupleSections #-}
  
  module Hoodle.Coroutine.TextInput where
  
  import Control.Applicative ()
  import Control.Concurrent (killThread)
  import qualified Control.Exception
  import Control.Lens (view, (%~), (.~), (?~), (^.), _2, _3)
  import Control.Monad (unless, void)
  import Control.Monad.IO.Class (liftIO)
  import Control.Monad.State (get, gets, modify, put)
  import Control.Monad.Trans.Class (lift)
  import Control.Monad.Trans.Crtn (CrtnErr (Other))
  import Control.Monad.Trans.Crtn.Event (ActionOrder)
  import Control.Monad.Trans.Crtn.Queue (enqueue)
  import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
  import Control.Monad.Trans.Maybe (MaybeT (..))
  import Data.Attoparsec.ByteString.Char8
    ( decimal,
      parseOnly,
    )
  import qualified Data.ByteString.Char8 as B
  import Data.Foldable (forM_, mapM_)
  import qualified Data.HashMap.Strict as M
  import Data.Hoodle.BBox
    ( BBox (..),
      getBBox,
    )
  import Data.Hoodle.Generic
    ( gembeddedtext,
      gitems,
    )
  import Data.Hoodle.Select (gselEmbeddedText)
  import Data.Hoodle.Simple
    ( Anchor (..),
      Dimension (..),
      Image (..),
      Item (..),
      Link (..),
      SVG (..),
      dimension,
      hoodleID,
      items,
      layers,
    )
  import Data.List (minimumBy)
  import qualified Data.Maybe as Maybe (fromMaybe)
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import qualified Data.Text.IO as TIO
  import Data.UUID.V4 (nextRandom)
  import Graphics.Hoodle.Render.Item (cnstrctRItem)
  import Graphics.Hoodle.Render.Type.HitTest
    ( AlterList (..),
      Hitted (..),
    )
  import Graphics.Hoodle.Render.Type.Hoodle (rHoodle2Hoodle, rPage2Page)
  import Graphics.Hoodle.Render.Type.Item (RItem (..))
  import qualified Graphics.Rendering.Cairo as Cairo
  import qualified Graphics.Rendering.Cairo.SVG as RSVG
  import qualified Graphics.UI.Gtk as Gtk
  import Hoodle.Accessor
    ( getCurrentPageCurr,
      getGeometry4CurrCvs,
      pureUpdateUhdl,
      updateUhdl,
    )
  import Hoodle.Coroutine.Commit (commit_)
  import Hoodle.Coroutine.Dialog
    ( fileChooser,
      keywordDialog,
      longTextMessageBox,
      okMessageBox,
    )
  import Hoodle.Coroutine.Draw
    ( callRenderer,
      doIOaction_,
      invalidateAll,
      invalidateInBBox,
      nextevent,
      updateFlagFromToggleUI,
      waitSomeEvent,
    )
  import Hoodle.Coroutine.LaTeX
    ( getLaTeXComponentsFromHdl,
      laTeXFooter,
      laTeXHeader,
    )
  import Hoodle.Coroutine.Mode (modeChange)
  import Hoodle.Coroutine.Network
    ( networkTextInput,
      networkTextInputBody,
    )
  import Hoodle.Coroutine.Page (canvasZoomUpdateAll)
  import Hoodle.Coroutine.Select.Clipboard
    ( deleteSelection,
      updateTempHoodleSelectM,
    )
  import Hoodle.ModelAction.Layer (getCurrentLayer)
  import Hoodle.ModelAction.Page (getPageFromGHoodleMap)
  import Hoodle.ModelAction.Select
    ( adjustItemPosition4Paste,
      makePageSelectMode,
    )
  import Hoodle.ModelAction.Select.Transform (changeItemBy)
  import Hoodle.ModelAction.Text
    ( getKeywordMap,
      getLinesFromText,
    )
  import Hoodle.Type.Canvas
    ( currentPageNum,
      unboxLens,
    )
  import Hoodle.Type.Coroutine (MainCoroutine, doIOaction)
  import Hoodle.Type.Enum (DrawFlag (Efficient))
  import Hoodle.Type.Event
    ( AllEvent (..),
      MultiLineEvent (..),
      NetworkEvent (..),
      RenderEvent (..),
      UserEvent (..),
      mkIOaction,
    )
  import Hoodle.Type.HoodleState
    ( HoodleModeState (SelectState, ViewAppendState),
      IsOneTimeSelectMode (YesAfterSelect),
      currentCanvasInfo,
      currentUnit,
      doesUseXInput,
      getCurrentCanvasId,
      getHoodle,
      hoodleModeState,
      isOneTimeSelectMode,
      networkEditSourceInfo,
      settings,
      statusBar,
      tempQueue,
      unitHoodles,
    )
  import Hoodle.Type.PageArrangement
    ( PageCoordinate (..),
      PageNum (..),
    )
  import Hoodle.Util
    ( UrlPath (FileUrl, HttpUrl),
      msgShout,
      urlParse,
    )
  import System.Directory
    ( doesFileExist,
      getCurrentDirectory,
      getTemporaryDirectory,
      setCurrentDirectory,
    )
  import System.Exit (ExitCode (..))
  import System.FilePath ((<.>), (</>))
  import System.Process (readProcessWithExitCode)
  import qualified Text.Hoodle.Parse.Attoparsec as PA
  import Prelude hiding (mapM_, readFile)
  
  -- | common dialog with multiline edit input box
  multiLineDialog :: T.Text -> (AllEvent -> IO ()) -> IO AllEvent
  multiLineDialog str evhandler = do
    dialog <- Gtk.dialogNew
    upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog)
    vbox <- Gtk.vBoxNew False 0
    Gtk.containerAdd upper vbox
    textbuf <- Gtk.textBufferNew Nothing
    Gtk.textBufferSetByteString textbuf (TE.encodeUtf8 str)
    _ <- textbuf `Gtk.on` Gtk.bufferChanged $ do
      (s, e) <- (,) <$> Gtk.textBufferGetStartIter textbuf <*> Gtk.textBufferGetEndIter textbuf
      contents <- Gtk.textBufferGetByteString textbuf s e False
      (evhandler . UsrEv . MultiLine . MultiLineChanged) (TE.decodeUtf8 contents)
    textarea <- Gtk.textViewNewWithBuffer textbuf
    vscrbar <- Gtk.vScrollbarNew =<< Gtk.textViewGetVadjustment textarea
    hscrbar <- Gtk.hScrollbarNew =<< Gtk.textViewGetHadjustment textarea
    Gtk.widgetSetSizeRequest textarea 500 600
    fdesc <- Gtk.fontDescriptionNew
    Gtk.fontDescriptionSetFamily fdesc ("Mono" :: String)
    Gtk.widgetModifyFont textarea (Just fdesc)
    --
    table <- Gtk.tableNew 2 2 False
    Gtk.tableAttachDefaults table textarea 0 1 0 1
    Gtk.tableAttachDefaults table vscrbar 1 2 0 1
    Gtk.tableAttachDefaults table hscrbar 0 1 1 2
    Gtk.boxPackStart vbox table Gtk.PackNatural 0
    --
    _btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk
    _btnCancel <- Gtk.dialogAddButton dialog ("Cancel" :: String) Gtk.ResponseCancel
    _btnNetwork <- Gtk.dialogAddButton dialog ("Network" :: String) (Gtk.ResponseUser 1)
    Gtk.widgetShowAll dialog
    res <- Gtk.dialogRun dialog
    Gtk.widgetDestroy dialog
    case res of
      Gtk.ResponseOk -> return (UsrEv (OkCancel True))
      Gtk.ResponseCancel -> return (UsrEv (OkCancel False))
      Gtk.ResponseUser 1 -> return (UsrEv (NetworkProcess NetworkDialog))
      _ -> return (UsrEv (OkCancel False))
  
  -- | main event loop for multiline edit box
  multiLineLoop :: T.Text -> MainCoroutine (Maybe T.Text)
  multiLineLoop txt = do
    r <- nextevent
    case r of
      UpdateCanvas cid ->
        invalidateInBBox Nothing Efficient cid
          >> multiLineLoop txt
      OkCancel True -> (return . Just) txt
      OkCancel False -> return Nothing
      NetworkProcess NetworkDialog -> networkTextInput txt
      MultiLine (MultiLineChanged txt') -> multiLineLoop txt'
      _ -> multiLineLoop txt
  
  -- | insert text
  textInput :: Maybe (Double, Double) -> T.Text -> MainCoroutine ()
  textInput mpos str = do
    case mpos of
      Just (x0, y0) -> do
        doIOaction (multiLineDialog str)
        multiLineLoop str
          >>= mapM_
            ( \result ->
                deleteSelection
                  >> liftIO (makePangoTextSVG (x0, y0) result)
                  >>= svgInsert (result, "pango")
            )
      Nothing -> msgShout "textInput: not implemented"
  
  -- | insert latex
  laTeXInput :: Maybe (Double, Double) -> T.Text -> MainCoroutine ()
  laTeXInput mpos str = do
    case mpos of
      Just (x0, y0) -> do
        doIOaction (multiLineDialog str)
        multiLineLoop str
          >>= mapM_
            ( \result ->
                liftIO (makeLaTeXSVG (x0, y0) Nothing result) >>= \case
                  Right r -> deleteSelection >> svgInsert (result, "latex") r
                  Left err -> okMessageBox err >> laTeXInput mpos result
            )
      Nothing -> do
        modeChange ToViewAppendMode
        autoPosText
          >>= maybe
            (laTeXInput (Just (100, 100)) str)
            (\y' -> laTeXInput (Just (100, y')) str)
  
  autoPosText :: MainCoroutine (Maybe Double)
  autoPosText = do
    cpg <- rPage2Page <$> getCurrentPageCurr
    let Dim _pgw pgh = view dimension cpg
        mcomponents = do
          l <- view layers cpg
          i <- view items l
          case i of
            ItemSVG svg ->
              case svg_command svg of
                Just "latex" -> do
                  let (_, y) = svg_pos svg
                      Dim _ h = svg_dim svg
                  return (y, y + h)
                _ -> []
            ItemImage img -> do
              let (_, y) = img_pos img
                  Dim _ h = img_dim img
              return (y, y + h)
            _ -> []
    if null mcomponents
      then return Nothing
      else do
        let y0 = (minimumBy (flip compare) . map snd) mcomponents
        if y0 + 10 > pgh then return Nothing else return (Just (y0 + 10))
  
  -- |
  laTeXInputNetwork :: Maybe (Double, Double) -> T.Text -> MainCoroutine ()
  laTeXInputNetwork mpos str =
    case mpos of
      Just (x0, y0) -> do
        networkTextInput str
          >>= mapM_
            ( \result ->
                liftIO (makeLaTeXSVG (x0, y0) Nothing result)
                  >>= \case
                    Right r -> deleteSelection >> svgInsert (result, "latex") r
                    Left err -> okMessageBox err >> laTeXInput mpos result
            )
      Nothing -> do
        modeChange ToViewAppendMode
        autoPosText
          >>= maybe
            (laTeXInputNetwork (Just (100, 100)) str)
            (\y' -> laTeXInputNetwork (Just (100, y')) str)
  
  dbusNetworkInput :: T.Text -> MainCoroutine ()
  dbusNetworkInput txt = do
    modeChange ToViewAppendMode
    mpos <- autoPosText
    let pos = maybe (100, 100) (100,) mpos
    rsvg <- liftIO (makeLaTeXSVG pos Nothing txt)
    case rsvg of
      Right r -> deleteSelection >> svgInsert (txt, "latex") r
      Left err -> okMessageBox err >> laTeXInput (Just pos) txt
  
  check :: String -> IO (ExitCode, String) -> ExceptT String IO ()
  check msg act = do
    er <- liftIO $ Control.Exception.try act
    case er of
      Left (Control.Exception.SomeException excp) -> throwE (show excp)
      Right (ecode, str) ->
        case ecode of
          ExitSuccess -> pure ()
          _ -> throwE (msg ++ ":" ++ str)
  
  makeLaTeXSVG ::
    (Double, Double) ->
    Maybe Dimension ->
    T.Text ->
    IO (Either String (B.ByteString, BBox))
  makeLaTeXSVG (x0, y0) mdim txt = do
    cdir <- getCurrentDirectory
    tdir <- getTemporaryDirectory
    tfilename <- show <$> nextRandom
    setCurrentDirectory tdir
    B.writeFile (tfilename <.> "tex") (TE.encodeUtf8 txt)
    r <- runExceptT $ do
      check "error during xelatex" $ do
        (ecode, ostr, estr) <- readProcessWithExitCode "xelatex" ["-shell-escape", tfilename <.> "tex"] ""
        return (ecode, ostr ++ estr)
      check "error during pdfcrop" $ do
        (ecode, ostr, estr) <- readProcessWithExitCode "pdfcrop" [tfilename <.> "pdf", tfilename ++ "_crop" <.> "pdf"] ""
        return (ecode, ostr ++ estr)
      check "error during pdf2svg" $ do
        (ecode, ostr, estr) <- readProcessWithExitCode "pdf2svg" [tfilename ++ "_crop" <.> "pdf", tfilename <.> "svg"] ""
        return (ecode, ostr ++ estr)
      bstr <- liftIO $ B.readFile (tfilename <.> "svg")
      rsvg <- liftIO $ RSVG.svgNewFromString (B.unpack bstr)
      let ow, oh :: Int
          (ow, oh) = RSVG.svgGetSize rsvg
          ow', oh' :: Double
          (ow', oh') = (fromIntegral ow, fromIntegral oh)
          w, h :: Double
          (w, h) = maybe (ow', oh') (\(Dim w' _) -> (w', oh' * w' / ow')) mdim
      return (bstr, BBox (x0, y0) (x0 + w, y0 + h))
    setCurrentDirectory cdir
    return r
  
  -- |
  svgInsert :: (T.Text, String) -> (B.ByteString, BBox) -> MainCoroutine ()
  svgInsert (txt, cmd) (svgbstr, BBox (x0, y0) (x1, y1)) = do
    xst <- get
    let uhdl = view (unitHoodles . currentUnit) xst
        cid = getCurrentCanvasId uhdl
        pgnum = view (unboxLens currentPageNum) . view currentCanvasInfo $ uhdl
        hdl = getHoodle uhdl
        currpage = getPageFromGHoodleMap pgnum hdl
        currlayer = getCurrentLayer currpage
    --
    callRenderer $
      GotRItem
        <$> cnstrctRItem (ItemSVG (SVG (Just (TE.encodeUtf8 txt)) (Just (B.pack cmd)) svgbstr (x0, y0) (Dim (x1 - x0) (y1 - y0))))
    RenderEv (GotRItem newitem) <-
      waitSomeEvent (\case RenderEv (GotRItem _) -> True; _ -> False)
    --
    let otheritems = view gitems currlayer
    let ntpg =
          makePageSelectMode
            currpage
            (otheritems :- Hitted [newitem] :- Empty)
    modeChange ToSelectMode
    updateUhdl $ \nuhdl -> do
      thdl <- case view hoodleModeState nuhdl of
        SelectState thdl' -> pure thdl'
        _ -> (lift . ExceptT . pure . Left . Other) "svgInsert"
      nthdl <- updateTempHoodleSelectM cid thdl ntpg pgnum
      return $ (hoodleModeState .~ SelectState nthdl) nuhdl
    commit_
    canvasZoomUpdateAll
    invalidateAll
  
  -- |
  convertLinkFromSimpleToDocID :: Link -> IO (Maybe Link)
  convertLinkFromSimpleToDocID (Link i _typ lstr txt cmd rdr pos dim) = do
    case urlParse (B.unpack lstr) of
      Nothing -> return Nothing
      Just (HttpUrl _url) -> return Nothing
      Just (FileUrl file) -> do
        b <- doesFileExist file
        if b
          then do
            bstr <- B.readFile file
            case parseOnly PA.hoodle bstr of
              Left _str -> return Nothing
              Right hdl -> do
                let uuid = view hoodleID hdl
                    link = LinkDocID i uuid (B.pack file) txt cmd rdr pos dim
                return (Just link)
          else return Nothing
  convertLinkFromSimpleToDocID _ = return Nothing
  
  -- |
  linkInsert ::
    B.ByteString ->
    (B.ByteString, FilePath) ->
    String ->
    (B.ByteString, BBox) ->
    MainCoroutine ()
  linkInsert _typ (uuidbstr, fname) str (svgbstr, BBox (x0, y0) (x1, y1)) = do
    xst <- get
    let uhdl = view (unitHoodles . currentUnit) xst
    let pgnum = view (currentCanvasInfo . unboxLens currentPageNum) uhdl
        lnk =
          Link
            uuidbstr
            "simple"
            (B.pack fname)
            (Just (B.pack str))
            Nothing
            svgbstr
            (x0, y0)
            (Dim (x1 - x0) (y1 - y0))
    nlnk <- liftIO $ convertLinkFromSimpleToDocID lnk >>= maybe (return lnk) return
    --
    callRenderer $
      GotRItem <$> cnstrctRItem (ItemLink nlnk)
    RenderEv (GotRItem newitem) <-
      waitSomeEvent (\case RenderEv (GotRItem _) -> True; _ -> False)
    --
    insertItemAt (Just (PageNum pgnum, PageCoord (x0, y0))) newitem
  
  -- | anchor
  addAnchor :: MainCoroutine ()
  addAnchor = do
    uuid <- liftIO nextRandom
    let uuidbstr = B.pack (show uuid)
    let anc = Anchor uuidbstr "" (100, 100) (Dim 50 50)
    --
    callRenderer $
      GotRItem <$> cnstrctRItem (ItemAnchor anc)
    RenderEv (GotRItem nitm) <-
      waitSomeEvent (\case RenderEv (GotRItem _) -> True; _ -> False)
    --
    insertItemAt Nothing nitm
  
  -- |
  makePangoTextSVG :: (Double, Double) -> T.Text -> IO (B.ByteString, BBox)
  makePangoTextSVG (xo, yo) str = do
    let pangordr = do
          ctxt <- Gtk.cairoCreateContext Nothing
          layout <- Gtk.layoutEmpty ctxt
          Gtk.layoutSetWidth layout (Just 400)
          Gtk.layoutSetWrap layout Gtk.WrapAnywhere
          Gtk.layoutSetText layout (T.unpack str) -- this is gtk2hs pango limitation
          (_, reclog) <- Gtk.layoutGetExtents layout
          let Gtk.PangoRectangle x y w h = reclog
          -- 10 is just dirty-fix
          return (layout, BBox (x, y) (x + w + 10, y + h))
        rdr layout = do
          Cairo.setSourceRGBA 0 0 0 1
          Gtk.updateLayout layout
          Gtk.showLayout layout
    (layout, BBox (x0, y0) (x1, y1)) <- pangordr
    tdir <- getTemporaryDirectory
    let tfile = tdir </> "embedded.svg"
    Cairo.withSVGSurface tfile (x1 - x0) (y1 - y0) $ \s ->
      Cairo.renderWith s (rdr layout)
    bstr <- B.readFile tfile
    return (bstr, BBox (xo, yo) (xo + x1 - x0, yo + y1 - y0))
  
  -- | combine all LaTeX texts into a text file
  combineLaTeXText :: MainCoroutine ()
  combineLaTeXText = do
    hdl <- gets (rHoodle2Hoodle . getHoodle . view (unitHoodles . currentUnit))
    let sorted = getLaTeXComponentsFromHdl hdl
        resulttxt = (T.intercalate "%%%%%%%%%%%%\n\n%%%%%%%%%%\n" . map (view (_2 . _3))) sorted
    mfilename <- fileChooser Gtk.FileChooserActionSave Nothing
    forM_ mfilename (\filename -> liftIO (TIO.writeFile filename resulttxt))
  
  insertItemAt ::
    Maybe (PageNum, PageCoordinate) ->
    RItem ->
    MainCoroutine ()
  insertItemAt mpcoord ritm = do
    xst <- get
    let uhdl = view (unitHoodles . currentUnit) xst
    geometry <- liftIO (getGeometry4CurrCvs uhdl)
    let cid = getCurrentCanvasId uhdl
        hdl = getHoodle uhdl
        (pgnum, mpos) = case mpcoord of
          Just (PageNum n, pos) -> (n, Just pos)
          Nothing -> (view (currentCanvasInfo . unboxLens currentPageNum) uhdl, Nothing)
        (ulx, uly) = (bbox_upperleft . getBBox) ritm
        nitms =
          case mpos of
            Nothing -> adjustItemPosition4Paste geometry (PageNum pgnum) [ritm]
            Just (PageCoord (nx, ny)) ->
              map (changeItemBy (\(x, y) -> (x + nx - ulx, y + ny - uly))) [ritm]
    let pg = getPageFromGHoodleMap pgnum hdl
        lyr = getCurrentLayer pg
        oitms = view gitems lyr
        ntpg = makePageSelectMode pg (oitms :- Hitted nitms :- Empty)
    modeChange ToSelectMode
    updateUhdl $ \uhdl' -> do
      thdl <- case view hoodleModeState uhdl' of
        SelectState thdl' -> return thdl'
        _ -> (lift . ExceptT . pure . Left . Other) "insertItemAt"
      nthdl <- updateTempHoodleSelectM cid thdl ntpg pgnum
      return . (hoodleModeState .~ SelectState nthdl)
        . (isOneTimeSelectMode .~ YesAfterSelect)
        $ uhdl'
    commit_
    canvasZoomUpdateAll
    invalidateAll
  
  embedTextSource :: MainCoroutine ()
  embedTextSource = do
    mfilename <- fileChooser Gtk.FileChooserActionOpen Nothing
    forM_ mfilename $ \filename -> do
      txt <- liftIO $ TIO.readFile filename
      pureUpdateUhdl $ \uhdl ->
        let nhdlmodst = case uhdl ^. hoodleModeState of
              ViewAppendState hdl -> ViewAppendState . (gembeddedtext ?~ txt) $ hdl
              SelectState thdl -> SelectState . (gselEmbeddedText ?~ txt) $ thdl
         in (hoodleModeState .~ nhdlmodst) uhdl
      commit_
  
  -- |
  editEmbeddedTextSource :: MainCoroutine ()
  editEmbeddedTextSource = do
    hdl <- gets (getHoodle . view (unitHoodles . currentUnit))
    let mtxt = hdl ^. gembeddedtext
    forM_ mtxt $ \txt -> do
      doIOaction (multiLineDialog txt)
      multiLineLoop txt >>= \case
        Nothing -> return ()
        Just ntxt -> do
          pureUpdateUhdl $ \uhdl ->
            let nhdlmodst = case uhdl ^. hoodleModeState of
                  ViewAppendState hdl' -> ViewAppendState . (gembeddedtext ?~ ntxt) $ hdl'
                  SelectState thdl -> SelectState . (gselEmbeddedText ?~ ntxt) $ thdl
             in (hoodleModeState .~ nhdlmodst) uhdl
          commit_
  
  -- |
  editNetEmbeddedTextSource :: MainCoroutine ()
  editNetEmbeddedTextSource = do
    hdl <- gets (getHoodle . view (unitHoodles . currentUnit))
    let mtxt = hdl ^. gembeddedtext
    forM_ mtxt $ \txt -> do
      networkTextInput txt >>= \case
        Nothing -> return ()
        Just ntxt -> networkReceived ntxt
  
  networkReceived :: T.Text -> MainCoroutine ()
  networkReceived txt = do
    pureUpdateUhdl $ \uhdl ->
      let nhdlmodst = case uhdl ^. hoodleModeState of
            ViewAppendState hdl -> ViewAppendState . (gembeddedtext ?~ txt) $ hdl
            SelectState thdl -> SelectState . (gselEmbeddedText ?~ txt) $ thdl
       in (hoodleModeState .~ nhdlmodst) uhdl
    commit_
  
  -- | insert text
  textInputFromSource :: (Double, Double) -> MainCoroutine ()
  textInputFromSource (x0, y0) =
    void $
      runMaybeT $ do
        txtsrc <- MaybeT $ gets ((^. gembeddedtext) . getHoodle . view (unitHoodles . currentUnit))
        lift $ modify (tempQueue %~ enqueue linePosDialog)
        (l1, l2) <- MaybeT linePosLoop
        let txt = getLinesFromText (l1, l2) txtsrc
        lift deleteSelection
        liftIO (makePangoTextSVG (x0, y0) txt)
          >>= lift . svgInsert ("embedtxt:simple:L" <> T.pack (show l1) <> "," <> T.pack (show l2), "pango")
  
  -- | common dialog with line position
  linePosDialog :: Either (ActionOrder AllEvent) AllEvent
  linePosDialog = mkIOaction $ \_evhandler -> do
    dialog <- Gtk.dialogNew
    upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog)
    vbox <- Gtk.vBoxNew False 0
    Gtk.containerAdd upper vbox
    hbox <- Gtk.hBoxNew False 0
    Gtk.boxPackStart vbox hbox Gtk.PackNatural 0
    line1buf <- Gtk.entryBufferNew (Nothing :: Maybe String)
    line1 <- Gtk.entryNewWithBuffer line1buf
    Gtk.boxPackStart hbox line1 Gtk.PackNatural 2
    line2buf <- Gtk.entryBufferNew (Nothing :: Maybe String)
    line2 <- Gtk.entryNewWithBuffer line2buf
    Gtk.boxPackStart hbox line2 Gtk.PackNatural 2
    --
    _btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk
    _btnCancel <- Gtk.dialogAddButton dialog ("Cancel" :: String) Gtk.ResponseCancel
    Gtk.widgetShowAll dialog
    res <- Gtk.dialogRun dialog
    Gtk.widgetDestroy dialog
    case res of
      Gtk.ResponseOk -> do
        line1str <- B.pack <$> Gtk.get line1buf Gtk.entryBufferText
        line2str <- B.pack <$> Gtk.get line2buf Gtk.entryBufferText
        let el1l2 =
              (,) <$> parseOnly decimal line1str
                <*> parseOnly decimal line2str
        return . UsrEv . LinePosition
          . either (const Nothing) (\(l1, l2) -> if l1 <= l2 then Just (l1, l2) else Nothing)
          $ el1l2
      Gtk.ResponseCancel -> return (UsrEv (LinePosition Nothing))
      _ -> return (UsrEv (LinePosition Nothing))
  
  -- | main event loop for line position dialog
  linePosLoop :: MainCoroutine (Maybe (Int, Int))
  linePosLoop = do
    r <- nextevent
    case r of
      UpdateCanvas cid -> invalidateInBBox Nothing Efficient cid >> linePosLoop
      LinePosition x -> return x
      _ -> linePosLoop
  
  -- | insert text
  laTeXInputKeyword ::
    (Double, Double) ->
    Maybe Dimension ->
    T.Text ->
    MaybeT MainCoroutine ()
  laTeXInputKeyword (x0, y0) mdim keyword = do
    txtsrc <- MaybeT $ gets ((^. gembeddedtext) . getHoodle . view (unitHoodles . currentUnit))
    subpart <- (MaybeT . return . M.lookup keyword . getKeywordMap) txtsrc
    let subpart' = laTeXHeader <> "\n" <> subpart <> laTeXFooter
    liftIO (makeLaTeXSVG (x0, y0) mdim subpart') >>= \case
      Right r -> lift $ do
        deleteSelection
        svgInsert ("embedlatex:keyword:" <> keyword, "latex") r
      Left err -> lift $ do
        longTextMessageBox err
        -- okMessageBox err
        return ()
  
  -- |
  laTeXInputFromSource :: (Double, Double) -> MainCoroutine ()
  laTeXInputFromSource (x0, y0) =
    void . runMaybeT $ do
      txtsrc <- MaybeT $ gets ((^. gembeddedtext) . getHoodle . view (unitHoodles . currentUnit))
      let keylst = (map fst . M.toList . getKeywordMap) txtsrc
      unless (null keylst) $ do
        keyword <- MaybeT (keywordDialog keylst)
        laTeXInputKeyword (x0, y0) Nothing keyword
  
  -- |
  toggleNetworkEditSource :: MainCoroutine ()
  toggleNetworkEditSource = do
    xst <- get
    let uhdl = view (unitHoodles . currentUnit) xst
        hdl = getHoodle uhdl
        mtxt = hdl ^. gembeddedtext
    b <- updateFlagFromToggleUI "TOGGLENETSRCA" (settings . doesUseXInput)
    forM_ (xst ^. statusBar) $ \stbar ->
      if b
        then do
          (ip, tid, _done) <- networkTextInputBody (Maybe.fromMaybe " " mtxt)
          doIOaction_ $ do
            let msg = "networkedit " ++ ip ++ " 4040"
            ctxt <- Gtk.statusbarGetContextId stbar ("networkedit" :: String)
            Gtk.statusbarPush stbar ctxt msg
          (put . ((settings . networkEditSourceInfo) ?~ tid)) xst
        else do
          case xst ^. (settings . networkEditSourceInfo) of
            Nothing -> return ()
            Just tid -> do
              doIOaction_ $ do
                killThread tid
                ctxt <- Gtk.statusbarGetContextId stbar ("networkedit" :: String)
                Gtk.statusbarPush stbar ctxt ("Now no networkedit" :: String)
              (put . ((settings . networkEditSourceInfo) .~ Nothing)) xst
  