{-# OPTIONS_GHC
    -XFunctionalDependencies
    -XNoMonomorphismRestriction
    -XFlexibleInstances
    -XMultiParamTypeClasses
    -XUndecidableInstances
    -XDeriveDataTypeable #-}
-----------------------------------------------------------------------------
--
-- Module      :  IDE.Core.ViewFrame
-- Copyright   :  (c) Juergen Nicklisch-Franken, Hamish Mackenzie
-- License     :  GNU-GPL
--
-- Maintainer  :  <maintainer at leksah.org>
-- Stability   :  provisional
-- Portability :  portable
--
--
-- | Splittable panes containing notebooks with any widgets
--
---------------------------------------------------------------------------------


module Graphics.UI.Frame.ViewFrame (
    removePaneAdmin
,   addPaneAdmin
,   notebookInsertOrdered
,   markLabel

-- * Convenience methods for accesing Pane state
,   posTypeToPaneDirection
,   paneDirectionToPosType
,   paneFromName
,   mbPaneFromName
,   guiPropertiesFromName

-- * View Actions
,   viewMove
,   viewSplitHorizontal
,   viewSplitVertical
--,   viewSplit
,   viewSplit'
,   viewNewGroup
,   newGroupOrBringToFront
,   bringGroupToFront
,   viewNest
,   viewNest'
,   viewDetach
,   viewDetach'
,   handleNotebookSwitch
,   viewCollapse
,   viewCollapse'
,   viewTabsPos
,   viewSwitchTabs

,   closeGroup
,   allGroupNames

-- * View Queries
,   getBestPanePath
,   getBestPathForId
,   getActivePanePath
,   getActivePanePathOrStandard
,   figureOutPaneName
,   getNotebook
,   getPaned
,   getActiveNotebook
,   getActivePane
,   setActivePane
,   getUiManager
,   getWindows
,   getMainWindow
,   getLayout
,   getPanesSt
,   getPaneMapSt
,   getPanePrim
,   getPanes

-- * View Actions
,   bringPaneToFront
,   newNotebook
,   newNotebook'

-- * Accessing GUI elements
--,   widgetFromPath
,   getUIAction
,   widgetGet

,   initGtkRc
) where

import Graphics.UI.Gtk hiding (afterToggleOverwrite,onToggleOverwrite)
import Control.Monad.Reader
import qualified Data.Map as Map
import Data.List
import Data.Maybe
import Data.Unique
import Data.Typeable

import Graphics.UI.Frame.Panes
import Graphics.UI.Editor.Parameters
import System.Glib (GObjectClass(..), isA)
#if MIN_VERSION_gtk(0,10,5)
import Graphics.UI.Gtk.Layout.Notebook (gTypeNotebook)
#else
import Graphics.UI.Gtk.Types (gTypeNotebook)
#endif
import System.CPUTime (getCPUTime)
#if MIN_VERSION_gtk(0,10,5)
import Graphics.UI.Gtk.Gdk.EventM (Modifier(..))
#else
import Graphics.UI.Gtk.Gdk.Enums (Modifier(..))
#endif
import MyMissing
import Graphics.UI.Gtk.Gdk.EventM (TimeStamp(..))
import Graphics.UI.Editor.MakeEditor
    (mkField, FieldDescription(..), buildEditor)
import Graphics.UI.Editor.Simple (stringEditor, okCancelFields)
import Control.Event (registerEvent)
import Graphics.UI.Editor.Basics
    (eventPaneName, GUIEventSelector(..))
import qualified Data.Set as  Set (unions, member)
import Data.Set (Set(..))
import Graphics.UI.Gtk.Gdk.Events (Event(..))

--import Debug.Trace (trace)
trace a b = b

groupPrefix = "_group_"

withoutGroupPrefix :: String -> String
withoutGroupPrefix s = case groupPrefix `stripPrefix` s of
                            Nothing -> s
                            Just s' -> s'

initGtkRc :: IO ()
initGtkRc = return ()
{--	rcParseString ("style \"leksah-close-button-style\"\n" ++
    "{\n" ++
    "  GtkWidget::focus-padding = 0\n" ++
    "  GtkWidget::focus-line-width = 0\n" ++
    "  xthickness = 0\n" ++
    "  ythickness = 0\n" ++
    "}\n" ++
    "widget \"*.leksah-close-button\" style \"leksah-close-button-style\"")
--}

removePaneAdmin :: RecoverablePane alpha beta delta =>  alpha -> delta ()
removePaneAdmin pane = do
    panes'          <-  getPanesSt
    paneMap'        <-  getPaneMapSt
    setPanesSt      (Map.delete (paneName pane) panes')
    setPaneMapSt    (Map.delete (paneName pane) paneMap')

addPaneAdmin :: RecoverablePane alpha beta delta => alpha -> Connections -> PanePath -> delta Bool
addPaneAdmin pane conn pp = do
    panes'          <-  getPanesSt
    paneMap'        <-  getPaneMapSt
    liftIO $ widgetSetName (getTopWidget pane) (paneName pane)
    let b1 = case Map.lookup (paneName pane) paneMap' of
                Nothing -> True
                Just it -> False
    let b2 = case Map.lookup (paneName pane) panes' of
                Nothing -> True
                Just it -> False
    if b1 && b2
        then do
            setPaneMapSt (Map.insert (paneName pane) (pp, conn) paneMap')
            setPanesSt (Map.insert (paneName pane) (PaneC pane) panes')
            return True
        else do
            trace  ("ViewFrame>addPaneAdmin:pane with this name already exist" ++ paneName pane) $
                return False

getPanePrim ::  RecoverablePane alpha beta delta => delta (Maybe alpha)
getPanePrim = do
    selectedPanes <- getPanes
    if null selectedPanes || length selectedPanes > 1
        then return Nothing
        else (return (Just $ head selectedPanes))

getPanes ::  RecoverablePane alpha beta delta => delta ([alpha])
getPanes = do
    panes' <- getPanesSt
    return (catMaybes
                $ map (\(PaneC p) -> cast p)
                    $ Map.elems panes')

notebookInsertOrdered :: PaneMonad alpha => (NotebookClass self, WidgetClass child)		
    => self	
    -> child	-- child - the Widget to use as the contents of the page.
    -> String
    -> Maybe Label	-- the label for the page as String or Label
    -> Bool
    -> alpha ()
notebookInsertOrdered nb widget labelStr mbLabel isGroup = do
    label	    <-  case mbLabel of
                        Nothing  -> liftIO $ labelNew (Just labelStr)
                        Just l  -> return l
    menuLabel   <-  liftIO $ labelNew (Just labelStr)
    numPages    <-  liftIO $ notebookGetNPages nb
    mbWidgets   <-  liftIO $ mapM (notebookGetNthPage nb) [0 .. (numPages-1)]
    let widgets =   map (\v -> forceJust v "ViewFrame.notebookInsertOrdered: no widget") mbWidgets
    labelStrs   <-  liftIO $ mapM widgetGetName widgets
    let pos     =   case findIndex (\ s -> withoutGroupPrefix s > withoutGroupPrefix labelStr) labelStrs of
                        Just i  ->  i
                        Nothing ->  -1
    labelBox    <-  if isGroup then groupLabel labelStr else mkLabelBox label labelStr
    liftIO $ do
        markLabel nb labelBox False
        realPos     <-  notebookInsertPageMenu nb widget labelBox menuLabel pos
        widgetShowAll labelBox
        notebookSetCurrentPage nb realPos

-- | Returns a label box
mkLabelBox :: PaneMonad alpha => Label -> String -> alpha EventBox
mkLabelBox lbl paneName = do
    (tb,lb) <- liftIO $ do
        miscSetAlignment (castToMisc lbl) 0.0 0.0
        miscSetPadding  (castToMisc lbl) 0 0

        labelBox  <- eventBoxNew
        eventBoxSetVisibleWindow labelBox False
        innerBox  <- hBoxNew False 0

        tabButton <- buttonNew
        widgetSetName tabButton "leksah-close-button"
        buttonSetFocusOnClick tabButton False
        buttonSetRelief tabButton ReliefNone
        buttonSetAlignment tabButton (0.0,0.0)

        image     <- imageNewFromStock stockClose IconSizeMenu
        mbPB <- widgetRenderIcon tabButton stockClose IconSizeMenu ""
        (height,width)   <-  case mbPB of
                                Nothing -> return (14,14)
                                Just pb -> do
                                h <- pixbufGetHeight pb
                                w <- pixbufGetWidth pb
                                return (h,w)
        on tabButton styleSet (\style -> do
            widgetSetSizeRequest tabButton (height + 2) (width + 2))
        containerSetBorderWidth tabButton 0
        containerAdd tabButton image

        boxPackStart innerBox lbl PackNatural 0
        boxPackEnd innerBox tabButton PackNatural 0

        containerAdd labelBox innerBox
        dragSourceSet labelBox [Button1] [ActionCopy,ActionMove]
        tl        <- targetListNew
        targetListAddTextTargets tl 0
        dragSourceSetTargetList labelBox tl
        on labelBox dragDataGet (\ cont id timeStamp -> do
            selectionDataSetText paneName
            return ())
        return (tabButton,labelBox)
    cl <- runInIO closeHandler
    liftIO $ onClicked tb (cl ())

    return lb
    where
        closeHandler :: PaneMonad alpha => () -> alpha ()
        closeHandler _ =    case groupPrefix `stripPrefix` paneName of
                                Just group  -> do
                                    closeGroup group
                                Nothing -> do
                                    (PaneC pane) <- paneFromName paneName
                                    closePane pane
                                    return ()

groupLabel :: PaneMonad beta => String -> beta EventBox
groupLabel group = do
    label <- liftIO $ labelNew Nothing
    liftIO $ labelSetUseMarkup label True
    liftIO $ labelSetMarkup label ("<b>" ++ group ++ "</b>")
    labelBox <- mkLabelBox label (groupPrefix ++ group)
    liftIO $ widgetShowAll labelBox
    return labelBox

-- | Add the change mark or removes it
markLabel :: (WidgetClass alpha, NotebookClass beta) => beta -> alpha -> Bool -> IO ()
markLabel nb topWidget modified = do
    mbBox   <- notebookGetTabLabel nb topWidget
    case mbBox of
        Nothing  -> return ()
        Just box -> do
            mbContainer <- binGetChild (castToBin box)
            case mbContainer of
                Nothing -> return ()
                Just container -> do
                    children <- containerGetChildren container
                    let label = castToLabel $ forceHead children "ViewFrame>>markLabel: empty children"
                    text <- widgetGetName topWidget
                    labelSetUseMarkup (castToLabel label) True
                    labelSetMarkup (castToLabel label)
                        (if modified
                              then "<span foreground=\"red\">" ++ text ++ "</span>"
                          else text)

-- | Constructs a unique pane name, which is an index and a string
figureOutPaneName :: PaneMonad alpha => String -> Int -> alpha (Int,String)
figureOutPaneName bn ind = do
    bufs <- getPanesSt
    let ind = foldr (\(PaneC buf) ind ->
                if primPaneName buf == bn
                    then max ind ((getAddedIndex buf) + 1)
                    else ind)
                0 (Map.elems bufs)
    if ind == 0
        then return (0,bn)
        else return (ind,bn ++ "(" ++ show ind ++ ")")

paneFromName :: PaneMonad alpha => PaneName -> alpha (IDEPane alpha)
paneFromName pn = do
    mbPane <- mbPaneFromName pn
    case mbPane of
        Just p -> return p
        Nothing -> error $ "ViewFrame>>paneFromName:Can't find pane from unique name " ++ pn

mbPaneFromName :: PaneMonad alpha => PaneName -> alpha (Maybe (IDEPane alpha))
mbPaneFromName pn = do
    panes  <- getPanesSt
    return (Map.lookup pn panes)

-- |
guiPropertiesFromName :: PaneMonad alpha => PaneName -> alpha (PanePath, Connections)
guiPropertiesFromName pn = do
    paneMap <- getPaneMapSt
    case Map.lookup pn paneMap of
            Just it -> return it
            otherwise  -> error $"Cant't find guiProperties from unique name " ++ pn

posTypeToPaneDirection PosLeft      =   LeftP
posTypeToPaneDirection PosRight     =   RightP	
posTypeToPaneDirection PosTop       =   TopP
posTypeToPaneDirection PosBottom    =   BottomP	

paneDirectionToPosType LeftP        =   PosLeft
paneDirectionToPosType RightP       =   PosRight   	
paneDirectionToPosType TopP         =   PosTop
paneDirectionToPosType BottomP      =   PosBottom

--
-- | Toggle the tabs of the current notebook
--
viewSwitchTabs :: PaneMonad alpha => alpha ()
viewSwitchTabs = do
    mbNb <- getActiveNotebook
    case mbNb of
        Nothing -> return ()
        Just nb -> liftIO $ do
            b <- notebookGetShowTabs nb
            notebookSetShowTabs nb (not b)

--
-- | Sets the tab position in the current notebook
--
viewTabsPos :: PaneMonad alpha => PositionType -> alpha ()
viewTabsPos pos = do
    mbNb <- getActiveNotebook
    case mbNb of
        Nothing -> return ()
        Just nb -> liftIO $notebookSetTabPos nb pos

--
-- | Split the currently active pane in horizontal direction
--
viewSplitHorizontal     :: PaneMonad alpha => alpha ()
viewSplitHorizontal     = viewSplit Horizontal

--
-- | Split the currently active pane in vertical direction
--
viewSplitVertical :: PaneMonad alpha => alpha ()
viewSplitVertical = viewSplit Vertical

--
-- | The active view can be split in two (horizontal or vertical)
--
viewSplit :: PaneMonad alpha => Direction -> alpha ()
viewSplit dir = do
    mbPanePath <- getActivePanePath
    case mbPanePath of
        Nothing -> return ()
        Just panePath -> do
            viewSplit' panePath dir

viewSplit' :: PaneMonad alpha => PanePath -> Direction -> alpha ()
viewSplit' panePath dir = do
    l <- getLayout
    case layoutFromPath panePath l of
        (TerminalP _ _ _ (Just _) _) -> trace ("ViewFrame>>viewSplit': can't split detached: ") return ()
        _                            -> do
            activeNotebook  <- (getNotebook' "viewSplit") panePath
            ind <- liftIO $ notebookGetCurrentPage activeNotebook
            mbPD <- do
                mbParent  <- liftIO $ widgetGetParent activeNotebook
                case mbParent of
                    Nothing -> trace ("ViewFrame>>viewSplit': parent not found: ") return Nothing
                    Just parent -> do
                        (nb,paneDir) <- do
                            let (name,altname,paneDir,
                                 oldPath,newPath) =  case dir of
                                                        Horizontal  -> ("top",
                                                                        "bottom",
                                                                        TopP,
                                                                        panePath ++ [SplitP TopP],
                                                                        panePath ++ [SplitP BottomP])
                                                        Vertical    -> ("left",
                                                                        "right",
                                                                        LeftP,
                                                                        panePath ++ [SplitP LeftP],
                                                                        panePath ++ [SplitP RightP])
                            adjustNotebooks panePath oldPath
                            frameState  <- getFrameState
                            setPanePathFromNB $ Map.insert activeNotebook oldPath (panePathFromNB frameState)
                            nb  <- newNotebook newPath
                            (np,nbi) <- liftIO $ do
                                newpane <- case dir of
                                              Horizontal  -> do  h <- vPanedNew
                                                                 return (castToPaned h)
                                              Vertical    -> do  v <- hPanedNew
                                                                 return (castToPaned v)
                                rName <- widgetGetName activeNotebook
                                widgetSetName newpane rName
                                widgetSetName nb altname
                                panedPack2 newpane nb True True
                                nbIndex <- if parent `isA` gTypeNotebook
                                            then notebookPageNum ((castToNotebook' "viewSplit'1") parent) activeNotebook
                                            else trace ("ViewFrame>>viewSplit': parent not a notebook: ") return Nothing
                                containerRemove (castToContainer parent) activeNotebook
                                widgetSetName activeNotebook name
                                panedPack1 newpane activeNotebook True True
                                return (newpane,nbIndex)
                            case (reverse panePath, nbi) of
                                (SplitP dir:_, _)
                                    | dir `elem` [TopP, LeftP] -> liftIO $ panedPack1 (castToPaned parent) np True True
                                    | otherwise                -> liftIO $ panedPack2 (castToPaned parent) np True True
                                (GroupP group:_, Just n) -> do
                                    liftIO $ notebookInsertPage ((castToNotebook' "viewSplit' 2") parent) np group n
                                    label <- groupLabel group
                                    liftIO $ notebookSetTabLabel ((castToNotebook' "viewSplit' 3") parent) np label
                                    label2 <- groupMenuLabel group
                                    liftIO $ notebookSetMenuLabel ((castToNotebook' "viewSplit' 4") parent) np label2
                                    return ()
                                ([], _) -> do
                                    liftIO $ boxPackStart (castToBox parent) np PackGrow 0
                                    liftIO $ boxReorderChild (castToVBox parent) np 2
                                _ -> error "No notebook index found in viewSplit"
                            liftIO $ do
                                widgetShowAll np
                                widgetGrabFocus activeNotebook
                                case nbi of
                                    Just n -> do
                                        notebookSetCurrentPage ((castToNotebook' "viewSplit' 5") parent) n
                                        return ()
                                    _      -> trace ("ViewFrame>>viewSplit': parent not a notebook2: ")return ()
                                return (nb,paneDir)
                        handleFunc <-  runInIO (handleNotebookSwitch nb)
                        liftIO $ afterSwitchPage nb handleFunc
                        return (Just (paneDir,dir))
            case mbPD of
              Just (paneDir,pdir) -> do
                  adjustPanes panePath (panePath ++ [SplitP paneDir])
                  adjustLayoutForSplit paneDir panePath
                  mbWidget <- liftIO $ notebookGetNthPage activeNotebook ind
                  when (isJust mbWidget) $ do
                    name <- liftIO $ widgetGetName (fromJust mbWidget)
                    mbPane  <- mbPaneFromName name
                    case mbPane of
                        Just (PaneC pane) -> move (panePath ++ [SplitP (otherDirection paneDir)]) pane
                        Nothing -> return ()
              Nothing -> return ()

--
-- | Two notebooks can be collapsed to one
--
viewCollapse :: PaneMonad alpha => alpha ()
viewCollapse = do
    mbPanePath        <- getActivePanePath
    case mbPanePath of
        Nothing -> return ()
        Just panePath -> do
            viewCollapse' panePath

viewCollapse' :: PaneMonad alpha => PanePath -> alpha ()
viewCollapse' panePath = trace "viewCollapse' called" $ do
    layout1           <- getLayoutSt
    case layoutFromPath panePath layout1 of
        (TerminalP _ _ _ (Just _) _) -> trace ("ViewFrame>>viewCollapse': can't collapse detached: ")
                                            return ()
        _                            -> do
            let newPanePath     = init panePath
            let mbOtherSidePath = otherSide panePath
            case mbOtherSidePath of
                Nothing -> trace ("ViewFrame>>viewCollapse': no other side path found: ") return ()
                Just otherSidePath -> do
                    nbop <- getNotebookOrPaned otherSidePath castToWidget
                    let nb = if nbop `isA` gTypeNotebook
                                then Just ((castToNotebook' "viewCollapse' 0") nbop)
                                else Nothing
                    case nb of
                        Nothing -> trace ("ViewFrame>>viewCollapse': other side path not collapsedXX: ") $
                                case layoutFromPath otherSidePath layout1 of
                                    VerticalP _ _ _ -> do
                                        viewCollapse' (otherSidePath ++ [SplitP LeftP])
                                        viewCollapse' panePath
                                    HorizontalP _ _ _ -> do
                                        viewCollapse' (otherSidePath ++ [SplitP TopP])
                                        viewCollapse' panePath
                                    otherwise -> trace ("ViewFrame>>viewCollapse': impossible1 ") return ()
                        Just otherSideNotebook -> do
                            paneMap           <- getPaneMapSt
                            activeNotebook    <- (getNotebook' "viewCollapse' 1") panePath
                            -- 1. Move panes and groups to one side (includes changes to paneMap and layout)
                            let paneNamesToMove = map (\(w,(p,_)) -> w)
                                                    $filter (\(w,(p,_)) -> otherSidePath == p)
                                                        $Map.toList paneMap
                            panesToMove       <- mapM paneFromName paneNamesToMove
                            mapM_ (\(PaneC p) -> move panePath p) panesToMove
                            let groupNames    =  map (\n -> groupPrefix ++ n) $
                                                        getGroupsFrom otherSidePath layout1
                            mapM_ (\n -> move' (n,activeNotebook)) groupNames
                            -- 2. Remove unused notebook from admin
                            st <- getFrameState
                            let ! newMap = Map.delete otherSideNotebook (panePathFromNB st)
                            setPanePathFromNB newMap
                            -- 3. Remove one level and reparent notebook
                            mbParent <- liftIO $ widgetGetParent activeNotebook
                            case mbParent of
                                Nothing -> error "collapse: no parent"
                                Just parent -> do
                                    mbGrandparent <- liftIO $ widgetGetParent parent
                                    case mbGrandparent of
                                        Nothing -> error "collapse: no grandparent"
                                        Just grandparent -> do
                                            nbIndex <- if grandparent `isA` gTypeNotebook
                                                then liftIO $ notebookPageNum ((castToNotebook' "viewCollapse'' 1") grandparent) parent
                                                else return Nothing
                                            liftIO $ containerRemove (castToContainer grandparent) parent
                                            liftIO $ containerRemove (castToContainer parent) activeNotebook
                                            if length panePath > 1
                                                then do
                                                    let lasPathElem = last newPanePath
                                                    case (lasPathElem, nbIndex) of
                                                        (SplitP dir, _) | dir == TopP || dir == LeftP ->
                                                            liftIO $ panedPack1 (castToPaned grandparent) activeNotebook True True
                                                        (SplitP dir, _) | dir == BottomP || dir == RightP ->
                                                            liftIO $ panedPack2 (castToPaned grandparent) activeNotebook True True
                                                        (GroupP group, Just n) -> do
                                                            liftIO $ notebookInsertPage ((castToNotebook' "viewCollapse'' 2") grandparent) activeNotebook group n
                                                            label <- groupLabel group
                                                            liftIO $ do
                                                                notebookSetTabLabel ((castToNotebook' "viewCollapse'' 3") grandparent) activeNotebook label
                                                                notebookSetCurrentPage ((castToNotebook' "viewCollapse'' 4") grandparent) n
                                                                return ()
                                                        _ -> error "collapse: Unable to find page index"
                                                    liftIO $ widgetSetName activeNotebook $panePathElementToWidgetName lasPathElem
                                                else liftIO $ do
                                                    boxPackStart (castToVBox grandparent) activeNotebook PackGrow 0
                                                    boxReorderChild (castToVBox grandparent) activeNotebook 2
                                                    widgetSetName activeNotebook "root"
                            -- 4. Change panePathFromNotebook
                            adjustNotebooks panePath newPanePath
                            -- 5. Change paneMap
                            adjustPanes panePath newPanePath
                            -- 6. Change layout
                            adjustLayoutForCollapse panePath

getGroupsFrom :: PanePath -> PaneLayout -> [String]
getGroupsFrom path layout =
    case layoutFromPath path layout of
        t@(TerminalP _ _ _ _ _)   -> Map.keys (paneGroups t)
        HorizontalP _ _ _   -> []
        VerticalP _ _ _     -> []

viewNewGroup :: PaneMonad alpha => alpha ()
viewNewGroup = do
    mainWindow <- getMainWindow
    mbGroupName <- liftIO $ groupNameDialog mainWindow
    case
     mbGroupName of
        Just groupName -> do
            layout <- getLayoutSt
            if groupName `Set.member` allGroupNames layout
                then liftIO $ do
                    md <- messageDialogNew (Just mainWindow) [] MessageWarning ButtonsClose
                        ("Group name not unique " ++ groupName)
                    dialogRun md
                    widgetDestroy md
                    return ()
                else viewNest groupName
        Nothing -> return ()

newGroupOrBringToFront :: PaneMonad alpha => String -> PanePath -> alpha (Maybe PanePath,Bool)
newGroupOrBringToFront groupName pp = do
    layout <- getLayoutSt
    if groupName `Set.member` allGroupNames layout
        then do
            mbPP <- bringGroupToFront groupName
            return (mbPP,False)
        else let realPath = getBestPanePath pp layout in do
            viewNest' realPath groupName
            return (Just (realPath ++ [GroupP groupName]),True)

bringGroupToFront :: PaneMonad alpha => String -> alpha (Maybe PanePath)
bringGroupToFront groupName = do
    layout <- getLayoutSt
    case findGroupPath groupName layout   of
        Just path -> do
            widget <- getNotebookOrPaned path castToWidget
            liftIO $ setCurrentNotebookPages widget
            return (Just path)
        Nothing -> return Nothing


--  Yet another stupid little dialog

groupNameDialog :: Window -> IO (Maybe String)
groupNameDialog parent =  liftIO $ do
    dia                        <-   dialogNew
    windowSetTransientFor dia parent
    windowSetTitle dia "Enter group name"
    upper                      <-   dialogGetUpper dia
    lower                      <-   dialogGetActionArea dia
    (widget,inj,ext,_)         <-   buildEditor moduleFields ""
    (widget2,_,_,notifier)     <-   buildEditor okCancelFields ()
    registerEvent notifier Clicked (Left (\e -> do
            case eventPaneName e of
                "Ok"    ->  dialogResponse dia ResponseOk
                _       ->  dialogResponse dia ResponseCancel
            return e))
    boxPackStart upper widget PackGrow 7
    boxPackStart lower widget2 PackNatural 7
    widgetShowAll dia
    resp <- dialogRun dia
    value                      <- ext ("")
    widgetDestroy dia
    case resp of
        ResponseOk | value /= Just ""  -> return value
        _                             -> return Nothing
    where
        moduleFields :: FieldDescription String
        moduleFields = VFD emptyParams [
                mkField
                    (paraName <<<- ParaName ("New group ")
                            $ emptyParams)
                    id
                    (\ a b -> a)
            (stringEditor (\s -> True))]

viewNest :: PaneMonad alpha => String -> alpha ()
viewNest group = do
    mbPanePath        <- getActivePanePath
    case mbPanePath of
        Nothing -> return ()
        Just panePath -> do
            viewNest' panePath group

viewNest' :: PaneMonad alpha => PanePath -> String -> alpha ()
viewNest' panePath group = do
    activeNotebook  <- (getNotebook' "viewNest' 1") panePath
    mbParent  <- liftIO $ widgetGetParent activeNotebook
    case mbParent of
        Nothing -> return ()
        Just parent -> do
            layout          <-  getLayoutSt
            let paneLayout  =   layoutFromPath panePath layout
            case paneLayout of
                (TerminalP {}) -> do
                    nb <- newNotebook (panePath ++ [GroupP group])
                    liftIO $ widgetSetName nb (groupPrefix ++ group)
                    notebookInsertOrdered activeNotebook nb group Nothing True
                    liftIO $ widgetShowAll nb
                        --widgetGrabFocus activeNotebook
                    handleFunc <-  runInIO (handleNotebookSwitch nb)
                    liftIO $ afterSwitchPage nb handleFunc
                    adjustLayoutForNest group panePath
                _ -> return ()

closeGroup :: PaneMonad alpha => String -> alpha ()
closeGroup groupName = do
    layout <- getLayout
    let mbPath = findGroupPath groupName layout
    mainWindow <- getMainWindow
    case mbPath of
        Nothing -> trace ("ViewFrame>>closeGroup: Group path not found: " ++ groupName) return ()
        Just path -> do
            panesMap <- getPaneMapSt
            let nameAndpathList  = filter (\(a,pp) -> path `isPrefixOf` pp)
                            $ map (\(a,b) -> (a,fst b)) (Map.assocs panesMap)
            continue <- case nameAndpathList of
                            (_:_) -> liftIO $ do
                                md <- messageDialogNew (Just mainWindow) [] MessageQuestion ButtonsYesNo
                                    ("Group " ++ groupName ++ " not empty. Close with all contents?")
                                rid <- dialogRun md
                                widgetDestroy md
                                case rid of
                                    ResponseYes ->  return True
                                    otherwise   ->  return False
                            []  -> return True
            when continue $ do
                panes <- mapM paneFromName $ map fst nameAndpathList
                results <- mapM (\ (PaneC p) -> closePane p) panes
                when (foldr (&&) True results) $ do
                    nbOrPaned  <- getNotebookOrPaned path castToWidget
                    mbParent <- liftIO $ widgetGetParent nbOrPaned
                    case mbParent of
                        Nothing -> error "ViewFrame>>closeGroup: closeGroup: no parent"
                        Just parent -> liftIO $ containerRemove (castToContainer parent) nbOrPaned
                    setLayoutSt (removeGL path layout)
                    ppMap <- getPanePathFromNB
                    setPanePathFromNB (Map.filter (\pa -> not (path `isPrefixOf` pa)) ppMap)

viewDetach :: PaneMonad alpha => alpha (Maybe (Window,Widget))
viewDetach = do
    id <- liftIO $ fmap show getCPUTime
    mbPanePath        <- getActivePanePath
    case mbPanePath of
        Nothing -> return Nothing
        Just panePath -> do
            viewDetach' panePath id

viewDetach' :: PaneMonad alpha => PanePath -> String -> alpha (Maybe (Window,Widget))
viewDetach' panePath id = do
    activeNotebook  <- (getNotebook' "viewDetach'") panePath
    mbParent  <- liftIO $ widgetGetParent activeNotebook
    case mbParent of
        Nothing -> return Nothing
        Just parent -> do
            layout          <-  getLayoutSt
            let paneLayout  =   layoutFromPath panePath layout
            case paneLayout of
                (TerminalP{detachedSize = size}) -> do
                    window <- liftIO $ do
                        window <- windowNew
                        windowSetTitle window "Leksah detached window"
                        widgetSetName window id
                        case size of
                            Just (width, height) -> do
                                windowSetDefaultSize window width height
                            Nothing -> do
                                (curWidth, curHeight) <- widgetGetSize activeNotebook
                                windowSetDefaultSize window curWidth curHeight
                        containerRemove (castToContainer parent) activeNotebook
                        containerAdd window activeNotebook
                        widgetShowAll window
                        return window
                    handleFunc <-  runInIO (handleReattach id window)
                    liftIO $ window `onDelete` handleFunc
                    windows <- getWindowsSt
                    setWindowsSt $ windows ++ [window]
                    adjustLayoutForDetach id panePath
                    return (Just (window, castToWidget activeNotebook))
                _ -> return Nothing



handleReattach :: PaneMonad alpha => String -> Window -> Event -> alpha Bool
handleReattach windowId window _ = do
    layout <- getLayout
    case findDetachedPath windowId layout of
        Nothing -> trace ("ViewFrame>>handleReattach: panePath for id not found: " ++ windowId)
                $ do
            windows <- getWindowsSt
            setWindowsSt $ delete window windows
            return False
        Just pp -> do
            nb      <- (getNotebook' "handleReattach") pp
            parent  <- getNotebookOrPaned (init pp) castToContainer
            liftIO $ containerRemove (castToContainer window) nb
            liftIO $ containerAdd parent nb
            adjustLayoutForReattach pp
            windows <- getWindowsSt
            setWindowsSt $ delete window windows
            case last pp of
                GroupP groupName -> do
                    label <- groupLabel groupName
                    liftIO $ notebookSetTabLabel ((castToNotebook' "handleReattach") parent) nb label
                otherwise       -> return ()
            return False -- "now destroy the window"



groupMenuLabel :: PaneMonad beta => String -> beta (Maybe Label)
groupMenuLabel group = liftM Just (liftIO $ labelNew (Just group))

handleNotebookSwitch :: PaneMonad beta => Notebook -> Int -> beta ()
handleNotebookSwitch nb index = do
    mbW <- liftIO $ notebookGetNthPage nb index
    case mbW of
        Nothing -> error "ViewFrame/handleNotebookSwitch: Can't find widget"
        Just w  -> do
            name   <-  liftIO $ widgetGetName w
            mbPane <-  findPaneFor name
            case mbPane of
                Nothing         ->  return ()
                Just (PaneC p)  ->  makeActive p
    where
        findPaneFor :: PaneMonad beta => String -> beta (Maybe (IDEPane beta))
        findPaneFor n1   =   do
            panes'      <-  getPanesSt
            foldM (\r (PaneC p) -> do
                n2 <- liftIO $ widgetGetName (getTopWidget p)
                return (if n1 == n2 then (Just (PaneC p)) else r))
                        Nothing (Map.elems panes')


--
-- | Moves the activePane in the given direction, if possible
-- | If their are many possibilities choose the leftmost and topmost
--
viewMove :: PaneMonad beta => PaneDirection -> beta  ()
viewMove direction = do
    mbPane <- getActivePaneSt
    case mbPane of
        Nothing -> do
            return ()
        Just (paneName,_) -> do
            (PaneC pane) <- paneFromName paneName
            mbPanePath <- getActivePanePath
            case mbPanePath of
                Nothing -> do
                    return ()
                Just panePath -> do
                  layout <- getLayoutSt
                  case findMoveTarget panePath layout direction of
                      Nothing -> do
                        return ()
                      Just moveTo -> move moveTo pane

--
-- | Find the target for a move
--
findMoveTarget :: PanePath -> PaneLayout -> PaneDirection -> Maybe PanePath
findMoveTarget panePath layout direction=
    let oppositeDir          = otherDirection direction
        canMove []           = []
        canMove reversedPath =
            case head reversedPath of
                SplitP d | d == oppositeDir
                    -> SplitP direction : (tail reversedPath)
                GroupP group -> []
                _                     -> canMove (tail reversedPath)
        basePath = reverse (canMove $ reverse panePath)
    in case basePath of
        [] -> Nothing
        _  -> let layoutP  = layoutFromPath basePath layout
             in  Just $basePath ++ findAppropriate layoutP oppositeDir

--
-- | Moves the given Pane to the given path
--
move ::  RecoverablePane alpha beta delta => PanePath -> alpha -> delta ()
move toPanePath pane = do
    let name    = paneName pane
    toNB        <- (getNotebook' "move") toPanePath
    move' (name,toNB)

--
-- | Moves the given Pane to the given path, care for groups (layout, paneMap)
--
move' :: PaneMonad alpha => (PaneName,Notebook) -> alpha ()
move' (paneName,toNB) = do
    paneMap         <-  getPaneMapSt
    panes           <-  getPanesSt
    layout          <-  getLayout
    frameState      <-  getFrameState
    case groupPrefix `stripPrefix` paneName of
        Just group  -> do
            case findGroupPath group layout of
                Nothing -> trace ("ViewFrame>>move': group not found: " ++ group) return ()
                Just fromPath -> do
                    groupNBOrPaned <- getNotebookOrPaned fromPath castToWidget
                    fromNB  <- (getNotebook' "move'") (init fromPath)
                    case toNB `Map.lookup` (panePathFromNB frameState) of
                        Nothing -> trace "ViewFrame>>move': panepath for Notebook not found1" return ()
                        Just toPath -> do
                            when (fromNB /= toNB && not (isPrefixOf fromPath toPath)) $ do
                                mbNum <- liftIO $ notebookPageNum fromNB groupNBOrPaned
                                case mbNum of
                                    Nothing ->  trace "ViewFrame>>move': group notebook not found" return ()
                                    Just num -> do
                                        liftIO $ notebookRemovePage fromNB num
                                        label <- groupLabel group
                                        notebookInsertOrdered toNB groupNBOrPaned group Nothing True
                                        liftIO $ notebookSetTabLabel toNB groupNBOrPaned label
                                        adjustPanes fromPath (toPath ++ [GroupP group])
                                        adjustLayoutForGroupMove fromPath toPath group
                                        adjustNotebooks fromPath (toPath ++ [GroupP group])
                                        layout2          <-  getLayout
                                        return ()
        Nothing     ->
            case paneName `Map.lookup` panes of
                Nothing -> trace ("ViewFrame>>move': pane not found: " ++ paneName) return ()
                Just (PaneC pane) -> do
                    case toNB `Map.lookup` (panePathFromNB frameState) of
                        Nothing -> trace "ViewFrame>>move': panepath for Notebook not found2" return ()
                        Just toPath ->
                            case paneName `Map.lookup`paneMap of
                                Nothing -> trace ("ViewFrame>>move': pane data not found: " ++ paneName)
                                            return ()
                                Just (fromPath,_) -> do
                                    let child = getTopWidget pane
                                    (fromPane,cid)  <-  guiPropertiesFromName paneName
                                    fromNB          <-  (getNotebook' "move'") fromPane
                                    when (fromNB /= toNB) $ do
                                        mbNum <- liftIO $ notebookPageNum fromNB child
                                        case mbNum of
                                            Nothing ->  trace "ViewFrame>>move': widget not found" return ()
                                            Just num -> do
                                                liftIO $ notebookRemovePage fromNB num
                                                notebookInsertOrdered toNB child paneName Nothing False
                                                let paneMap1    =   Map.delete paneName paneMap
                                                setPaneMapSt    $   Map.insert paneName (toPath,cid) paneMap1

findAppropriate :: PaneLayout -> PaneDirection -> PanePath
findAppropriate  (TerminalP {}) _ =   []
findAppropriate  (HorizontalP t b _) LeftP     =   SplitP TopP    :  findAppropriate t LeftP
findAppropriate  (HorizontalP t b _) RightP    =   SplitP TopP    :  findAppropriate t RightP
findAppropriate  (HorizontalP t b _) BottomP   =   SplitP BottomP :  findAppropriate b BottomP
findAppropriate  (HorizontalP t b _) TopP      =   SplitP TopP    :  findAppropriate b TopP
findAppropriate  (VerticalP l r _) LeftP       =   SplitP LeftP   :  findAppropriate l LeftP
findAppropriate  (VerticalP l r _) RightP      =   SplitP RightP  :  findAppropriate r RightP
findAppropriate  (VerticalP l r _) BottomP     =   SplitP LeftP   :  findAppropriate l BottomP
findAppropriate  (VerticalP l r _) TopP        =   SplitP LeftP   :  findAppropriate l TopP

--
-- | Bring the pane to the front position in its notebook
--
bringPaneToFront :: RecoverablePane alpha beta delta => alpha -> IO ()
bringPaneToFront pane = do
    let tv = getTopWidget pane
    setCurrentNotebookPages tv


setCurrentNotebookPages widget = do
    mbParent <- widgetGetParent widget
    case mbParent of
        Just parent -> do
            setCurrentNotebookPages parent
            if parent `isA` gTypeNotebook
                then do
                    mbPageNum <- notebookPageNum ((castToNotebook' "setCurrentNotebookPage 1") parent) widget
                    case mbPageNum of
                        Just pageNum -> do
                            notebookSetCurrentPage ((castToNotebook' "setCurrentNotebookPage 2") parent) pageNum
                            return ()
                        Nothing      -> return ()
                else return ()
        Nothing -> return ()

--
-- | Get a valid panePath from a standard path.
--
getBestPanePath :: StandardPath -> PaneLayout -> PanePath
getBestPanePath sp pl = reverse $ getStandard' sp pl []
    where
    getStandard' (GroupP group:sp) (TerminalP {paneGroups = groups}) p
        | group `Map.member` groups                 =   getStandard' sp (groups Map.! group) (GroupP group:p)
    getStandard' _ (TerminalP {}) p              =   p
    getStandard' (SplitP LeftP:sp) (VerticalP l r _) p     =   getStandard' sp l (SplitP LeftP:p)
    getStandard' (SplitP RightP:sp) (VerticalP l r _) p    =   getStandard' sp r (SplitP RightP:p)
    getStandard' (SplitP TopP:sp) (HorizontalP t b _) p    =   getStandard' sp t (SplitP TopP:p)
    getStandard' (SplitP BottomP:sp) (HorizontalP t b _) p =   getStandard' sp b (SplitP BottomP:p)
    -- if no match get leftmost topmost
    getStandard' _ (VerticalP l r _) p              =   getStandard' [] l (SplitP LeftP:p)
    getStandard' _ (HorizontalP t b _) p            =   getStandard' [] t (SplitP TopP:p)

--
-- | Get a standard path.
--
getBestPathForId :: PaneMonad alpha => String -> alpha PanePath
getBestPathForId  id = do
    p <- panePathForGroup id
    l <- getLayout
    return (getBestPanePath p l)
		
--
-- | Construct a new notebook
--
newNotebook' :: IO Notebook
newNotebook' = do
    nb <- notebookNew
    notebookSetTabPos nb PosTop
    notebookSetShowTabs nb True
    notebookSetScrollable nb True
    notebookSetPopup nb True
    return nb

--
-- | Construct a new notebook,
--
newNotebook :: PaneMonad alpha => PanePath -> alpha Notebook
newNotebook pp = do
    st  <- getFrameState
    nb  <- liftIO newNotebook'
    setPanePathFromNB $ Map.insert nb pp (panePathFromNB st)
    func <- runInIO move'
    liftIO $ do
        tl <- targetListNew
        targetListAddTextTargets tl 0
        dragDestSet nb [DestDefaultAll] [ActionCopy, ActionMove]
        dragDestSetTargetList nb tl
        on nb dragDataReceived (dragFunc nb func)
        return nb
    where
        dragFunc ::
            Notebook ->
            ((PaneName,Notebook) -> IO ()) ->
            DragContext ->
            Point ->
            InfoId ->
            TimeStamp ->
            (SelectionDataM ())
        dragFunc nb func cont point id timeStamp = do
            mbText <- selectionDataGetText
            case mbText of
                Nothing -> return ()
                Just str -> do
                    liftIO $ func (str,nb)
                    return ()

terminalsWithPanePath :: PaneLayout -> [(PanePath,PaneLayout)]
terminalsWithPanePath pl = map (\ (pp,l) -> (reverse pp,l)) $ terminalsWithPP [] pl
    where
        terminalsWithPP pp t@(TerminalP groups _ _ _ _) =  [(pp,t)]
                                            ++ concatMap (terminalsFromGroup pp) (Map.toList groups)
        terminalsWithPP pp (VerticalP l r _)       =  terminalsWithPP (SplitP LeftP : pp) l
                                                        ++ terminalsWithPP (SplitP RightP : pp) r
        terminalsWithPP pp (HorizontalP t b _)     =  terminalsWithPP (SplitP TopP : pp) t
                                                        ++ terminalsWithPP (SplitP BottomP : pp) b
        terminalsFromGroup pp (name,layout)        =  terminalsWithPP (GroupP name : pp) layout

findGroupPath :: String -> PaneLayout -> Maybe PanePath
findGroupPath group layout =
    let terminalPairs = terminalsWithPanePath layout
    in case (filter filterFunc terminalPairs) of
        [] -> Nothing
        (pp,_) : [] -> Just (pp ++ [GroupP group])
        _ -> error ("ViewFrame>>group name not unique: " ++ group)
    where
        filterFunc (_,(TerminalP groups _ _ _ _)) =  group  `Set.member` Map.keysSet groups
        filterFunc _                              =  error "ViewFrame>>findGroupPath: impossible"

findDetachedPath :: String -> PaneLayout -> Maybe PanePath
findDetachedPath id layout =
    let terminalPairs = terminalsWithPanePath layout
    in case (filter filterFunc terminalPairs) of
        [] -> Nothing
        (pp,_) : [] -> Just pp
        _ -> error ("ViewFrame>>window id not unique: " ++ id)
    where
        filterFunc (_,(TerminalP _ _ _ (Just lid) _)) = lid == id
        filterFunc _                                  = False


allGroupNames :: PaneLayout -> Set String
allGroupNames pl = Set.unions $ map getFunc (terminalsWithPanePath pl)
    where
        getFunc (_,(TerminalP groups _ _ _ _)) =  Map.keysSet groups
        getFunc _                              =  error "ViewFrame>>allGroupNames: impossible"


--
-- | Get another pane path which points to the other side at the same level
--
otherSide :: PanePath -> Maybe PanePath
otherSide []    =   Nothing
otherSide p     =   let rp = reverse p
                    in case head rp of
                        SplitP d -> Just (reverse $ SplitP (otherDirection d) : tail rp)
                        _        -> Nothing

--
-- | Get the opposite direction of a pane direction
--
otherDirection :: PaneDirection -> PaneDirection
otherDirection LeftP    = RightP
otherDirection RightP   = LeftP
otherDirection TopP     = BottomP
otherDirection BottomP  = TopP

--
-- | Get the layout at the given pane path
--
layoutFromPath :: PanePath -> PaneLayout -> PaneLayout
layoutFromPath [] l                                   = l
layoutFromPath (GroupP group:r) (TerminalP {paneGroups = groups})
    | group `Map.member` groups                       = layoutFromPath r (groups Map.! group)
layoutFromPath (SplitP TopP:r) (HorizontalP t _ _)    = layoutFromPath r t
layoutFromPath (SplitP BottomP:r) (HorizontalP _ b _) = layoutFromPath r b
layoutFromPath (SplitP LeftP:r) (VerticalP l _ _)     = layoutFromPath r l
layoutFromPath (SplitP RightP:r) (VerticalP _ ri _)   = layoutFromPath r ri
layoutFromPath pp l                                   = error
    $"inconsistent layout (layoutFromPath) " ++ show pp ++ " " ++ show l

layoutsFromPath :: PanePath -> PaneLayout -> [PaneLayout]
layoutsFromPath (GroupP group:r) layout@(TerminalP {paneGroups = groups})
    | group `Map.member` groups
        = layout:layoutsFromPath r (groups Map.! group)
layoutsFromPath [] layout                                     =   [layout]
layoutsFromPath (SplitP TopP:r) layout@(HorizontalP t b _)    =   layout:layoutsFromPath r t
layoutsFromPath (SplitP BottomP:r) layout@(HorizontalP t b _) =   layout:layoutsFromPath r b
layoutsFromPath (SplitP LeftP:r) layout@(VerticalP l ri _)    =   layout:layoutsFromPath r l
layoutsFromPath (SplitP RightP:r) layout@(VerticalP l ri _)   =   layout:layoutsFromPath r ri
layoutsFromPath pp l                                      = error
    $"inconsistent layout (layoutsFromPath) " ++ show pp ++ " " ++ show l

getWidgetNameList :: PanePath -> PaneLayout -> [String]
getWidgetNameList path layout = reverse $ nameList (reverse path) (reverse $ layoutsFromPath path layout)
    where
        nameList [] _ = reverse ["Leksah Main Window","topBox","root"]
        nameList (pe:_) (TerminalP{detachedId = Just id}:_) = [panePathElementToWidgetName pe, id]
        nameList (pe:rpath) (_:rlayout) = panePathElementToWidgetName pe : nameList rpath rlayout
        nameList _ _ = error $ "inconsistent layout (getWidgetNameList) " ++ show path ++ " " ++ show layout

getNotebookOrPaned :: PaneMonad alpha => PanePath -> (Widget -> beta) -> alpha beta
getNotebookOrPaned p cf = do
    layout <- getLayout
    (widgetGet $ getWidgetNameList p layout) cf

--
-- | Get the notebook widget for the given pane path
--
getNotebook :: PaneMonad alpha => PanePath -> alpha  Notebook
getNotebook p = getNotebookOrPaned p (castToNotebook' ("getNotebook " ++ show p))

getNotebook' :: PaneMonad alpha => String -> PanePath -> alpha  Notebook
getNotebook' str p = getNotebookOrPaned p (castToNotebook' ("getNotebook' " ++ str ++ " " ++ show p))


--
-- | Get the (gtk) Paned widget for a given path
--
getPaned :: PaneMonad alpha => PanePath -> alpha Paned
getPaned p = getNotebookOrPaned p castToPaned

--
-- | Get the path to the active pane
--
getActivePanePath :: PaneMonad alpha => alpha  (Maybe PanePath)
getActivePanePath = do
    mbPane   <- getActivePaneSt
    case mbPane of
        Nothing -> return Nothing
        Just (paneName,_) -> do
            (pp,_)  <- guiPropertiesFromName paneName
            return (Just (pp))

getActivePanePathOrStandard :: PaneMonad alpha => StandardPath -> alpha  (PanePath)
getActivePanePathOrStandard sp = do
    mbApp <- getActivePanePath
    case mbApp of
        Just app -> return app
        Nothing -> do
            layout <- getLayoutSt
            return (getBestPanePath sp layout)

--
-- | Get the active notebook
--
getActiveNotebook :: PaneMonad alpha => alpha  (Maybe Notebook)
getActiveNotebook = do
    mbPanePath <- getActivePanePath
    case mbPanePath of
        Just panePath -> do
            nb <- (getNotebook' "getActiveNotebook") panePath
            return (Just nb)
        Nothing -> return Nothing


--
-- | Translates a pane direction to the widget name
--
paneDirectionToWidgetName           :: PaneDirection -> String
paneDirectionToWidgetName TopP      =  "top"
paneDirectionToWidgetName BottomP   =  "bottom"
paneDirectionToWidgetName LeftP     =  "left"
paneDirectionToWidgetName RightP    =  "right"

panePathElementToWidgetName :: PanePathElement -> String
panePathElementToWidgetName (SplitP dir)   = paneDirectionToWidgetName dir
panePathElementToWidgetName (GroupP group) = groupPrefix ++ group

--
-- | Changes a pane path in the pane map
--
adjustPanes :: PaneMonad alpha => PanePath -> PanePath -> alpha ()
adjustPanes fromPane toPane  = do
    paneMap     <- getPaneMapSt
    setPaneMapSt (Map.map (\(pp,other) ->
        case stripPrefix fromPane pp of
            Just rest -> (toPane ++ rest,other)
            _         -> (pp,other)) paneMap)

adjustNotebooks :: PaneMonad alpha => PanePath -> PanePath -> alpha ()
adjustNotebooks fromPane toPane  = do
    npMap <- trace ("+++ adjustNotebooks from: " ++ show fromPane ++ " to " ++ show toPane)
                getPanePathFromNB
    setPanePathFromNB  (Map.map (\pp ->
        case stripPrefix fromPane pp of
            Just rest -> toPane ++ rest
            _         -> pp) npMap)

--
-- | Changes the layout for a split
--
adjustLayoutForSplit :: PaneMonad alpha => PaneDirection -> PanePath -> alpha ()
adjustLayoutForSplit  dir path  = do
    layout          <-  getLayoutSt
    let paneLayout  =   layoutFromPath path layout
        newLayout   =   TerminalP Map.empty Nothing 0 Nothing Nothing
        newTerm     =   case dir of
                            LeftP   -> VerticalP paneLayout newLayout 0
                            RightP  -> VerticalP newLayout paneLayout 0
                            TopP    -> HorizontalP paneLayout newLayout 0
                            BottomP -> HorizontalP newLayout paneLayout 0
    setLayoutSt     $   adjustLayout path layout newTerm

--
-- | Changes the layout for a nest
--
adjustLayoutForNest :: PaneMonad alpha => String -> PanePath -> alpha ()
adjustLayoutForNest group path = do
    layout          <-  getLayoutSt
    let paneLayout  =   layoutFromPath path layout
        newTerm     =   case paneLayout of
                            (TerminalP {paneGroups = groups}) -> paneLayout {
                                paneGroups = Map.insert group (TerminalP Map.empty Nothing 0 Nothing Nothing) groups}
                            _          -> error "Unexpected layout type in adjustLayoutForNest"
    setLayoutSt     $   adjustLayout path layout newTerm

--
-- | Changes the layout for a detach
--
adjustLayoutForDetach :: PaneMonad alpha => String -> PanePath -> alpha ()
adjustLayoutForDetach id path = do
    layout          <-  getLayoutSt
    let paneLayout  =   layoutFromPath path layout
        newTerm     =   case paneLayout of
                            (TerminalP {}) -> paneLayout {detachedId = Just id}
                            _              -> error "Unexpected layout type in adjustLayoutForDetach"
    setLayoutSt     $   adjustLayout path layout newTerm

--
-- | Changes the layout for a reattach
--
adjustLayoutForReattach :: PaneMonad alpha => PanePath -> alpha ()
adjustLayoutForReattach path = do
    layout          <-  getLayoutSt
    let paneLayout  =   layoutFromPath path layout
        newTerm     =   case paneLayout of
                            (TerminalP {}) -> paneLayout {detachedId = Nothing, detachedSize = Nothing}
                            _   -> error "Unexpected layout type in adjustLayoutForReattach"
    setLayoutSt     $   adjustLayout path layout newTerm

--
-- | Changes the layout for a collapse
--
adjustLayoutForCollapse :: PaneMonad alpha => PanePath -> alpha ()
adjustLayoutForCollapse oldPath  = do
    layout          <-  getLayoutSt
    let pathLayout  =   layoutFromPath oldPath layout
    setLayoutSt     $   adjustLayout (init oldPath) layout pathLayout

--
-- | Changes the layout for a move
--
adjustLayoutForGroupMove :: PaneMonad alpha => PanePath -> PanePath -> String -> alpha ()
adjustLayoutForGroupMove fromPath toPath group = do
    layout <- getLayout
    let layoutToMove = layoutFromPath fromPath layout
    let newLayout = removeGL fromPath layout
    setLayoutSt (addGL layoutToMove (toPath ++ [GroupP group])  newLayout)

--
-- | Changes the layout for a remove
--
adjustLayoutForGroupRemove :: PaneMonad alpha => PanePath -> String -> alpha ()
adjustLayoutForGroupRemove fromPath group = do
    layout <- getLayout
    setLayoutSt (removeGL fromPath layout)

--
-- | Remove group layout at a certain path
--
removeGL :: PanePath -> PaneLayout -> PaneLayout
removeGL [GroupP group] t@(TerminalP oldGroups _ _ _ _)
    | group `Map.member` oldGroups                        =  t{paneGroups = group `Map.delete` oldGroups}
removeGL (GroupP group:r)  old@(TerminalP {paneGroups = groups})
    | group `Map.member` groups                             = old{paneGroups = Map.adjust (removeGL r) group groups}
removeGL (SplitP TopP:r)  (HorizontalP tp bp _)     = HorizontalP (removeGL r tp) bp 0
removeGL (SplitP BottomP:r)  (HorizontalP tp bp _)  = HorizontalP tp (removeGL r bp) 0
removeGL (SplitP LeftP:r)  (VerticalP lp rp _)      = VerticalP (removeGL r lp) rp 0
removeGL (SplitP RightP:r)  (VerticalP lp rp _)     = VerticalP lp (removeGL r rp) 0
removeGL p l = error $"ViewFrame>>removeGL: inconsistent layout " ++ show p ++ " " ++ show l

--
-- | Add group layout at a certain path
--
addGL :: PaneLayout -> PanePath -> PaneLayout -> PaneLayout
addGL toAdd [GroupP group] t@(TerminalP oldGroups _ _ _ _)  =  t{paneGroups = Map.insert group toAdd oldGroups}
addGL toAdd (GroupP group:r)  old@(TerminalP {paneGroups = groups})
    | group `Map.member` groups = old{paneGroups       = Map.adjust (addGL toAdd r) group groups}
addGL toAdd (SplitP TopP:r)  (HorizontalP tp bp _)     = HorizontalP (addGL toAdd r tp) bp 0
addGL toAdd (SplitP BottomP:r)  (HorizontalP tp bp _)  = HorizontalP tp (addGL toAdd r bp) 0
addGL toAdd (SplitP LeftP:r)  (VerticalP lp rp _)      = VerticalP (addGL toAdd r lp) rp 0
addGL toAdd (SplitP RightP:r)  (VerticalP lp rp _)     = VerticalP lp (addGL toAdd r rp) 0
addGL _ p l = error $"ViewFrame>>addGL: inconsistent layout" ++ show p ++ " " ++ show l

--
-- | Changes the layout by replacing element at pane path (pp) with replace
--
adjustLayout :: PanePath -> PaneLayout -> PaneLayout -> PaneLayout
adjustLayout pp layout replace    = adjust' pp layout
    where
    adjust' [] _                                       = replace
    adjust' (GroupP group:r)  old@(TerminalP {paneGroups = groups})
        | group `Map.member` groups =
            old{paneGroups = Map.adjust (adjustPaneGroupLayout r) group groups}
    adjust' (SplitP TopP:r)  (HorizontalP tp bp _)     = HorizontalP (adjust' r tp) bp 0
    adjust' (SplitP BottomP:r)  (HorizontalP tp bp _)  = HorizontalP tp (adjust' r bp) 0
    adjust' (SplitP LeftP:r)  (VerticalP lp rp _)      = VerticalP (adjust' r lp) rp 0
    adjust' (SplitP RightP:r)  (VerticalP lp rp _)     = VerticalP lp (adjust' r rp) 0
    adjust' p l = error $"inconsistent layout (adjust) " ++ show p ++ " " ++ show l
    adjustPaneGroupLayout p group = adjust' p group

--
-- | Get the widget from a list of strings
--
widgetFromPath :: Widget -> [String] -> IO (Widget)
widgetFromPath w [] = return w
widgetFromPath w path = do
    children    <- containerGetChildren (castToContainer w)
    chooseWidgetFromPath children path

chooseWidgetFromPath :: [Widget] -> [String] -> IO (Widget)
chooseWidgetFromPath _ [] = error $"Cant't find widget (empty path)"
chooseWidgetFromPath widgets (h:t) = do
    names       <- mapM widgetGetName widgets
    let mbiInd  =  findIndex (== h) names
    case mbiInd of
        Nothing     -> error $"Cant't find widget path " ++ show (h:t) ++ " found only " ++ show names
        Just ind    -> widgetFromPath (widgets !! ind) t

widgetGet :: PaneMonad alpha => [String] -> (Widget -> b) -> alpha  (b)
widgetGet strL cf = do
    windows <- getWindowsSt
    r <- liftIO $chooseWidgetFromPath (map castToWidget windows) strL
    return (cf r)

widgetGetRel :: Widget -> [String] -> (Widget -> b) -> IO (b)
widgetGetRel w sl cf = do
    r <- widgetFromPath w sl
    return (cf r)

getUIAction :: PaneMonad alpha => String -> (Action -> a) -> alpha (a)
getUIAction str f = do
    uiManager <- getUiManagerSt
    liftIO $ do
        findAction <- uiManagerGetAction uiManager str
        case findAction of
            Just act -> return (f act)
            Nothing  -> error $"getUIAction can't find action " ++ str

getThis :: PaneMonad delta =>  (FrameState delta -> alpha) -> delta alpha
getThis sel = do
    st <- getFrameState
    return (sel st)
setThis :: PaneMonad delta =>  (FrameState delta -> alpha -> FrameState delta) -> alpha -> delta ()
setThis sel value = do
    st <- getFrameState
    trace ("!!! setFrameState " ++ show (sel st value)) $ setFrameState (sel st value)

getWindowsSt    = getThis windows
setWindowsSt    = setThis (\st value -> st{windows = value})
getUiManagerSt  = getThis uiManager
getPanesSt      =  getThis panes
setPanesSt      = setThis (\st value -> st{panes = value})
getPaneMapSt    = getThis paneMap
setPaneMapSt    = setThis (\st value -> st{paneMap = value})
getActivePaneSt = getThis activePane
setActivePaneSt = setThis (\st value -> st{activePane = value})
getLayoutSt     = getThis layout
setLayoutSt     = setThis (\st value -> st{layout = value})
getPanePathFromNB  = getThis panePathFromNB
setPanePathFromNB  = setThis (\st value -> st{panePathFromNB = value})

getActivePane   = getActivePaneSt
setActivePane   = setActivePaneSt
getUiManager    = getUiManagerSt
getWindows      = getWindowsSt
getMainWindow   = liftM head getWindows
getLayout       = getLayoutSt

castToNotebook' :: GObjectClass obj => String -> obj -> Notebook
castToNotebook' str obj = if obj `isA` gTypeNotebook
                            then castToNotebook obj
                            else error ("Not a notebook " ++ str)