gi-gtk-hs 0.3.2.0 → 0.3.3.0
raw patch · 3 files changed
+46/−48 lines, 3 files
Files
- gi-gtk-hs.cabal +1/−1
- src/Data/GI/Gtk/ModelView/CustomStore.hs +43/−44
- src/Data/GI/Gtk/ModelView/Types.hs +2/−3
gi-gtk-hs.cabal view
@@ -1,5 +1,5 @@ name: gi-gtk-hs-version: 0.3.2.0+version: 0.3.3.0 synopsis: A wrapper for gi-gtk, adding a few more idiomatic API parts on top description: A wrapper for gi-gtk, adding a few more idiomatic API parts on top homepage: https://github.com/haskell-gi/gi-gtk-hs
src/Data/GI/Gtk/ModelView/CustomStore.hs view
@@ -69,7 +69,7 @@ (ManagedPtr(..), GObject(..), GType, CGType(..), gtypeToCGType, gtypeInt, gtypeBoolean, gtypeString, gtypeInvalid) import Data.GI.Base.BasicConversions (gflagsToWord, withTextCString)-import Data.GI.Base.ManagedPtr (newPtr, newObject, withManagedPtr)+import Data.GI.Base.ManagedPtr (newObject, withManagedPtr) import Data.GI.Base.GValue (GValue(..)) import GI.GObject (Object) import GI.GdkPixbuf.Objects (Pixbuf(..))@@ -129,20 +129,19 @@ -> (row -> ty) -- ^ the function that sets the property -> m () customStoreSetColumn model (ColumnId _ setter colId) acc | colId<0 = return ()- | otherwise =- case toTypedTreeModel model of- TypedTreeModel model -> liftIO $ do- ptr <- withForeignPtr model gtk2hs_store_get_impl- impl <- deRefStablePtr ptr- let cMap = customStoreColumns impl- cols <- readIORef cMap- let l = fromIntegral $ length cols- if colId>=l then do- let fillers = replicate (fromIntegral $ colId-l) CAInvalid- writeIORef cMap (cols++fillers++[setter acc])- else do- let (beg,_:end) = splitAt (fromIntegral colId) cols- writeIORef cMap (beg++setter acc:end)+ | otherwise = liftIO $ do+ putStrLn "Here 2"+ ptr <- withManagedPtr (toTypedTreeModel model) gtk2hs_store_get_impl+ impl <- deRefStablePtr ptr+ let cMap = customStoreColumns impl+ cols <- readIORef cMap+ let l = fromIntegral $ length cols+ if colId>=l then do+ let fillers = replicate (fromIntegral $ colId-l) CAInvalid+ writeIORef cMap (cols++fillers++[setter acc])+ else do+ let (beg,_:end) = splitAt (fromIntegral colId) cols+ writeIORef cMap (beg++setter acc:end) data CustomStoreImplementation model row = CustomStoreImplementation { customStoreColumns :: ColumnMap row, -- provide access via columns@@ -230,19 +229,24 @@ -- ^ Functions to enable this store to receive drag events. -> m (model row) customStoreNew priv con tmIface mDragSource mDragDest = liftIO $ do+ putStrLn "Here 3" cMap <- columnMapNew let dummyDragSource = DragSourceIface { customDragSourceRowDraggable = \_ _ -> return False, customDragSourceDragDataGet = \_ _ _ -> return False, customDragSourceDragDataDelete = \_ _ -> return False } let dummyDragDest = DragDestIface { customDragDestRowDropPossible = \_ _ _ -> return False, customDragDestDragDataReceived = \_ _ _ -> return False }+ putStrLn "Here 4" implPtr <- newStablePtr CustomStoreImplementation { customStoreColumns = cMap, customStoreIface = tmIface, customTreeDragSourceIface = fromMaybe dummyDragSource mDragSource, customTreeDragDestIface = fromMaybe dummyDragDest mDragDest }+ putStrLn "Here 5" privPtr <- newStablePtr priv+ putStrLn "Here 6" storePtr <- gtk2hs_store_new implPtr privPtr+ putStrLn "Here 7" con <$> newObject CustomStore storePtr @@ -254,11 +258,10 @@ -- | Extract a row of the given model at the given 'TreeIter'. -- customStoreGetRow :: (MonadIO m, IsTypedTreeModel model) => model row -> TreeIter -> m row-customStoreGetRow model iter = liftIO $- case toTypedTreeModel model of- TypedTreeModel model -> do- impl <- withForeignPtr model gtk2hs_store_get_impl >>= deRefStablePtr- treeModelIfaceGetRow (customStoreIface impl) iter+customStoreGetRow model iter = liftIO $ do+ putStrLn "Here 1"+ impl <- withManagedPtr (toTypedTreeModel model) gtk2hs_store_get_impl >>= deRefStablePtr+ treeModelIfaceGetRow (customStoreIface impl) iter foreign import ccall unsafe "Gtk2HsStore.h gtk2hs_store_get_impl" gtk2hs_store_get_impl :: Ptr (TypedTreeModel row) -> IO (StablePtr (CustomStoreImplementation model row))@@ -339,14 +342,18 @@ foreign export ccall "gtk2hs_store_get_flags_impl" treeModelIfaceGetFlags_static :: StablePtr (CustomStoreImplementation model row) -> IO CInt +tempManagedPtr :: Ptr a -> IO (ManagedPtr a)+tempManagedPtr p = do+ isOwned <- newIORef False+ fPtr <- newForeignPtr_ p+ return $ ManagedPtr fPtr isOwned treeModelIfaceGetIter_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreePath -> IO CInt treeModelIfaceGetIter_static storePtr iterPtr pathPtr = do- isOwned <- newIORef False- ptr <- newForeignPtr_ iterPtr- let iterOut = TreeIter $ ManagedPtr ptr isOwned -- Take care not to use this outside of this function+ iterOut <- TreeIter <$> tempManagedPtr iterPtr -- Take care not to use this outside of this function store <- customStoreIface <$> deRefStablePtr storePtr- path <- newBoxed TreePath pathPtr+ isOwned' <- newIORef False+ path <- treePathCopy . TreePath =<< tempManagedPtr pathPtr treeModelIfaceGetIter store path >>= \case Nothing -> return (fromBool False) Just iter -> do treeIterOverwrite iterOut iter@@ -406,9 +413,7 @@ treeModelIfaceIterNext_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> IO CInt treeModelIfaceIterNext_static storePtr iterPtr = do- isOwned <- newIORef False- ptr <- newForeignPtr_ iterPtr- let iterOut = TreeIter $ ManagedPtr ptr isOwned -- Take care not to use this outside of this function+ iterOut <- TreeIter <$> tempManagedPtr iterPtr -- Take care not to use this outside of this function store <- customStoreIface <$> deRefStablePtr storePtr iter <- newBoxed TreeIter iterPtr treeModelIfaceIterNext store iter >>= \case@@ -422,9 +427,7 @@ treeModelIfaceIterChildren_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt treeModelIfaceIterChildren_static storePtr iterPtr parentIterPtr = do- isOwned <- newIORef False- ptr <- newForeignPtr_ iterPtr- let iterOut = TreeIter $ ManagedPtr ptr isOwned -- Take care not to use this outside of this function+ iterOut <- TreeIter <$> tempManagedPtr iterPtr -- Take care not to use this outside of this function store <- customStoreIface <$> deRefStablePtr storePtr parentIter <- maybeNull (newBoxed TreeIter) parentIterPtr treeModelIfaceIterChildren store parentIter >>= \case@@ -458,9 +461,7 @@ treeModelIfaceIterNthChild_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> CInt -> IO CInt treeModelIfaceIterNthChild_static storePtr iterPtr parentIterPtr n = do- isOwned <- newIORef False- ptr <- newForeignPtr_ iterPtr- let iterOut = TreeIter $ ManagedPtr ptr isOwned -- Take care not to use this outside of this function+ iterOut <- TreeIter <$> tempManagedPtr iterPtr -- Take care not to use this outside of this function store <- customStoreIface <$> deRefStablePtr storePtr parentIter <- maybeNull (newBoxed TreeIter) parentIterPtr treeModelIfaceIterNthChild store parentIter (fromIntegral n) >>= \case@@ -474,9 +475,7 @@ treeModelIfaceIterParent_static :: StablePtr (CustomStoreImplementation model row) -> Ptr TreeIter -> Ptr TreeIter -> IO CInt treeModelIfaceIterParent_static storePtr iterPtr childIterPtr = do- isOwned <- newIORef False- ptr <- newForeignPtr_ iterPtr- let iterOut = TreeIter $ ManagedPtr ptr isOwned -- Take care not to use this outside of this function+ iterOut <- TreeIter <$> tempManagedPtr iterPtr -- Take care not to use this outside of this function store <- customStoreIface <$> deRefStablePtr storePtr childIter <- newBoxed TreeIter childIterPtr iter <- treeModelIfaceIterParent store childIter@@ -512,7 +511,7 @@ customDragSourceRowDraggable_static mPtr storePtr pathPtr = do model <- newObject TreeModel mPtr store <- customTreeDragSourceIface <$> deRefStablePtr storePtr- path <- newBoxed TreePath pathPtr+ path <- treePathCopy . TreePath =<< tempManagedPtr pathPtr fromBool <$> customDragSourceRowDraggable store (unsafeTreeModelToGeneric model) path foreign export ccall "gtk2hs_store_row_draggable_impl"@@ -522,8 +521,8 @@ customDragSourceDragDataGet_static mPtr storePtr pathPtr selectionPtr = do model <- newObject TreeModel mPtr store <- customTreeDragSourceIface <$> deRefStablePtr storePtr- path <- newBoxed TreePath pathPtr- selection <- newBoxed SelectionData selectionPtr+ path <- treePathCopy . TreePath =<< tempManagedPtr pathPtr+ selection <- selectionDataCopy . SelectionData =<< tempManagedPtr selectionPtr fromBool <$> customDragSourceDragDataGet store (unsafeTreeModelToGeneric model) path selection foreign export ccall "gtk2hs_store_drag_data_get_impl"@@ -533,7 +532,7 @@ customDragSourceDragDataDelete_static mPtr storePtr pathPtr = do model <- newObject TreeModel mPtr store <- customTreeDragSourceIface <$> deRefStablePtr storePtr- path <- newBoxed TreePath pathPtr+ path <- treePathCopy . TreePath =<< tempManagedPtr pathPtr fromBool <$> customDragSourceDragDataDelete store (unsafeTreeModelToGeneric model) path foreign export ccall "gtk2hs_store_drag_data_delete_impl"@@ -543,8 +542,8 @@ customDragDestDragDataReceived_static mPtr storePtr pathPtr selectionPtr = do model <- newObject TreeModel mPtr store <- customTreeDragDestIface <$> deRefStablePtr storePtr- path <- newBoxed TreePath pathPtr- selection <- newBoxed SelectionData selectionPtr+ path <- treePathCopy . TreePath =<< tempManagedPtr pathPtr+ selection <- selectionDataCopy . SelectionData =<< tempManagedPtr selectionPtr fromBool <$> customDragDestDragDataReceived store (unsafeTreeModelToGeneric model) path selection foreign export ccall "gtk2hs_store_drag_data_received_impl"@@ -554,8 +553,8 @@ customDragDestRowDropPossible_static mPtr storePtr pathPtr selectionPtr = do model <- newObject TreeModel mPtr store <- customTreeDragDestIface <$> deRefStablePtr storePtr- path <- newBoxed TreePath pathPtr- selection <- newBoxed SelectionData selectionPtr+ path <- treePathCopy . TreePath =<< tempManagedPtr pathPtr+ selection <- selectionDataCopy . SelectionData =<< tempManagedPtr selectionPtr fromBool <$> customDragDestRowDropPossible store (unsafeTreeModelToGeneric model) path selection foreign export ccall "gtk2hs_store_row_drop_possible_impl"
src/Data/GI/Gtk/ModelView/Types.hs view
@@ -79,7 +79,6 @@ import Control.Exception (catch) import Foreign.Storable (Storable(..)) import Foreign.Ptr (Ptr, castPtr, plusPtr, minusPtr, nullPtr)-import Foreign.ForeignPtr (ForeignPtr, newForeignPtr_) import Foreign.C.Types (CInt(..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (toBool)@@ -111,7 +110,7 @@ equalManagedPtr a b = managedForeignPtr (coerce a :: ManagedPtr ()) == managedForeignPtr (coerce b :: ManagedPtr ()) -newtype TypedTreeModel row = TypedTreeModel (ForeignPtr (TypedTreeModel row))+newtype TypedTreeModel row = TypedTreeModel (ManagedPtr (TypedTreeModel row)) class IsTypedTreeModel model where dummy :: model a -> a@@ -142,7 +141,7 @@ instance IsTypedTreeModel TypedTreeModelSort -newtype TypedTreeModelFilter row = TypedTreeModelFilter (ForeignPtr (TypedTreeModelFilter row))+newtype TypedTreeModelFilter row = TypedTreeModelFilter (ManagedPtr (TypedTreeModelFilter row)) unsafeTreeModelFilterToGeneric :: TreeModelFilter -> TypedTreeModelFilter row unsafeTreeModelFilterToGeneric = unsafeCoerce#