ltk 0.16.1.0 → 0.16.2.0
raw patch · 3 files changed
+100/−90 lines, 3 files
Files
- ltk.cabal +2/−2
- src/Graphics/UI/Frame/Panes.hs +1/−1
- src/Graphics/UI/Frame/ViewFrame.hs +97/−87
ltk.cabal view
@@ -1,5 +1,5 @@ name: ltk-version: 0.16.1.0+version: 0.16.2.0 cabal-version: >=1.8 build-type: Simple license: GPL@@ -14,7 +14,7 @@ UI Framework used by leksah category: GUI author: Juergen "jutaro" Nicklisch-Franken-tested-with: GHC ==8.2.1 || ==8.0.2 || ==7.10.3+tested-with: GHC ==8.2.1 || ==8.0.2 source-repository head type: git
src/Graphics/UI/Frame/Panes.hs view
@@ -200,7 +200,7 @@ , uiManager :: UIManager , panes :: Map PaneName (IDEPane delta) , paneMap :: Map PaneName (PanePath, Connections)-, activePane :: Maybe (PaneName, Connections)+, activePane :: (Maybe (PaneName, Connections), [PaneName]) , panePathFromNB :: ! (Map (Ptr Notebook) PanePath) , layout :: PaneLayout} deriving Show
src/Graphics/UI/Frame/ViewFrame.hs view
@@ -85,6 +85,7 @@ , getPaneMapSt , getPanePrim , getPanes+, getMRUPanes -- * View Actions , bringPaneToFront@@ -195,6 +196,7 @@ (constructMessageDialogButtons, setMessageDialogMessageType) import GI.Gtk.Objects.Label (noLabel) import GI.Gtk.Objects.Widget (widgetSetTooltipText)+import GHC.Stack (HasCallStack) -- import Debug.Trace (trace) trace (a::String) b = b@@ -550,7 +552,7 @@ mbPanePath <- getActivePanePath forM_ mbPanePath viewCollapse' -viewCollapse' :: PaneMonad alpha => PanePath -> alpha ()+viewCollapse' :: (HasCallStack, PaneMonad alpha) => PanePath -> alpha () viewCollapse' panePath = trace "viewCollapse' called" $ do layout1 <- getLayoutSt case layoutFromPath panePath layout1 of@@ -561,73 +563,81 @@ let mbOtherSidePath = otherSide panePath case mbOtherSidePath of Nothing -> trace "ViewFrame>>viewCollapse': no other side path found: " return ()- Just otherSidePath -> do- nbop <- getNotebookOrPaned otherSidePath return- nb <- liftIO $ castTo Notebook nbop- case nb of+ Just otherSidePath ->+ getNotebookOrPaned otherSidePath (castTo Notebook) >>= \case 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- _ -> 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) -> viewMoveTo 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- notebookPtr <- liftIO $ unsafeManagedPtrCastPtr otherSideNotebook- let ! newMap = Map.delete notebookPtr (panePathFromNB st)- setPanePathFromNB newMap- -- 3. Remove one level and reparent notebook- parent <- widgetGetParent activeNotebook >>= liftIO . unsafeCastTo Container . fromJust- grandparent <- widgetGetParent parent >>= liftIO . unsafeCastTo Container . fromJust- nbIndex <- liftIO $ castTo Notebook grandparent >>= \case- Just notebook -> notebookPageNum notebook parent- Nothing -> return (-1)- containerRemove grandparent parent- containerRemove parent activeNotebook- if length panePath > 1- then do- let lasPathElem = last newPanePath- case (lasPathElem, nbIndex) of- (SplitP dir, _) | dir == TopP || dir == LeftP -> do- paned <- liftIO $ unsafeCastTo Paned grandparent- panedPack1 paned activeNotebook True False- (SplitP dir, _) | dir == BottomP || dir == RightP -> do- paned <- liftIO $ unsafeCastTo Paned grandparent- panedPack2 paned activeNotebook True False- (GroupP group, n) | n >= 0 -> do- grandParentNotebook <- liftIO $ unsafeCastTo Notebook grandparent- label <- groupLabel group- notebookInsertPage grandParentNotebook activeNotebook (Just label) n- notebookSetCurrentPage grandParentNotebook n- return ()- _ -> error "collapse: Unable to find page index"- widgetSetName activeNotebook $panePathElementToWidgetName lasPathElem- else do- box <- liftIO $ unsafeCastTo Box grandparent- boxPackStart box activeNotebook True True 0- boxReorderChild box activeNotebook 2- widgetSetName activeNotebook "root"- -- 4. Change panePathFromNotebook- adjustNotebooks panePath newPanePath- -- 5. Change paneMap- adjustPanes panePath newPanePath- -- 6. Change layout- adjustLayoutForCollapse panePath+ case layoutFromPath otherSidePath layout1 of+ VerticalP{} -> do+ viewCollapse' (otherSidePath ++ [SplitP LeftP])+ viewCollapse' panePath+ HorizontalP{} -> do+ viewCollapse' (otherSidePath ++ [SplitP TopP])+ viewCollapse' panePath+ _ -> trace "ViewFrame>>viewCollapse': impossible1 " return ()+ Just otherSideNotebook ->+ getNotebookOrPaned panePath (castTo Notebook) >>= \case+ Nothing -> trace "ViewFrame>>viewCollapse': path not collapsedXX: " $+ case layoutFromPath panePath layout1 of+ VerticalP{} -> do+ viewCollapse' (panePath ++ [SplitP LeftP])+ viewCollapse' panePath+ HorizontalP{} -> do+ viewCollapse' (panePath ++ [SplitP TopP])+ viewCollapse' panePath+ _ -> trace "ViewFrame>>viewCollapse': impossible1 " return ()+ Just activeNotebook -> do+ paneMap <- getPaneMapSt+ -- 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) -> viewMoveTo 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+ notebookPtr <- liftIO $ unsafeManagedPtrCastPtr otherSideNotebook+ let ! newMap = Map.delete notebookPtr (panePathFromNB st)+ setPanePathFromNB newMap+ -- 3. Remove one level and reparent notebook+ parent <- widgetGetParent activeNotebook >>= liftIO . unsafeCastTo Container . fromJust+ grandparent <- widgetGetParent parent >>= liftIO . unsafeCastTo Container . fromJust+ nbIndex <- liftIO $ castTo Notebook grandparent >>= \case+ Just notebook -> notebookPageNum notebook parent+ Nothing -> return (-1)+ containerRemove grandparent parent+ containerRemove parent activeNotebook+ if length panePath > 1+ then do+ let lasPathElem = last newPanePath+ case (lasPathElem, nbIndex) of+ (SplitP dir, _) | dir == TopP || dir == LeftP -> do+ paned <- liftIO $ unsafeCastTo Paned grandparent+ panedPack1 paned activeNotebook True False+ (SplitP dir, _) | dir == BottomP || dir == RightP -> do+ paned <- liftIO $ unsafeCastTo Paned grandparent+ panedPack2 paned activeNotebook True False+ (GroupP group, n) | n >= 0 -> do+ grandParentNotebook <- liftIO $ unsafeCastTo Notebook grandparent+ label <- groupLabel group+ notebookInsertPage grandParentNotebook activeNotebook (Just label) n+ notebookSetCurrentPage grandParentNotebook n+ return ()+ _ -> error "collapse: Unable to find page index"+ widgetSetName activeNotebook $panePathElementToWidgetName lasPathElem+ else do+ box <- liftIO $ unsafeCastTo Box grandparent+ boxPackStart box activeNotebook True True 0+ boxReorderChild box 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 -> [Text] getGroupsFrom path layout =@@ -876,11 +886,10 @@ -- | If their are many possibilities choose the leftmost and topmost -- viewMove :: PaneMonad beta => PaneDirection -> beta ()-viewMove direction = do- mbPane <- getActivePaneSt- case mbPane of- Nothing -> return ()- Just (paneName,_) -> do+viewMove direction =+ getActivePaneSt >>= \case+ (Nothing, _) -> return ()+ (Just (paneName,_),_) -> do (PaneC pane) <- paneFromName paneName mbPanePath <- getActivePanePath case mbPanePath of@@ -1133,11 +1142,10 @@ -- | 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+otherSide p =+ case reverse p of+ (SplitP d:rest) -> Just . reverse $ SplitP (otherDirection d) : rest+ _ -> Nothing -- -- | Get the opposite direction of a pane direction@@ -1193,7 +1201,7 @@ getNotebook :: PaneMonad alpha => PanePath -> alpha Notebook getNotebook p = getNotebookOrPaned p (unsafeCastTo Notebook) -getNotebook' :: PaneMonad alpha => Text -> PanePath -> alpha Notebook+getNotebook' :: (HasCallStack, PaneMonad alpha) => Text -> PanePath -> alpha Notebook getNotebook' str p = getNotebookOrPaned p (unsafeCastTo Notebook) @@ -1207,18 +1215,16 @@ -- | 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+getActivePanePath =+ getActivePaneSt >>= \case+ (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+getActivePanePathOrStandard sp =+ getActivePanePath >>= \case Just app -> return app Nothing -> do layout <- getLayoutSt@@ -1458,6 +1464,10 @@ setActivePane = setActivePaneSt getUiManager = getUiManagerSt getWindows = getWindowsSt-getMainWindow = liftM head getWindows+getMainWindow = head <$> getWindows getLayout = getLayoutSt+getMRUPanes =+ getActivePane >>= \case+ (Nothing, mru) -> return mru+ (Just (n, _), mru) -> return (n:mru)