{-# LANGUAGE CPP #-}-- -*-haskell-*--- GIMP Toolkit (GTK) CustomStore TreeModel---- Author : Duncan Coutts, Axel Simon---- Created: 11 Feburary 2006---- Copyright (C) 2005 Duncan Coutts, Axel Simon---- This library is free software; you can redistribute it and/or-- modify it under the terms of the GNU Lesser General Public-- License as published by the Free Software Foundation; either-- version 2.1 of the License, or (at your option) any later version.---- This library is distributed in the hope that it will be useful,-- but WITHOUT ANY WARRANTY; without even the implied warranty of-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU-- Lesser General Public License for more details.---- |-- Maintainer : gtk2hs-users@lists.sourceforge.net-- Stability : provisional-- Portability : portable (depends on GHC)---- Standard model to store list data.--moduleGraphics.UI.Gtk.ModelView.ListStore(-- * Types ListStore,-- * ConstructorslistStoreNew,listStoreNewDND,-- * Implementation of InterfaceslistStoreDefaultDragSourceIface,listStoreDefaultDragDestIface,-- * MethodslistStoreIterToIndex,listStoreGetValue,listStoreSetValue,listStoreToList,listStoreGetSize,listStoreInsert,listStorePrepend,listStoreAppend,listStoreRemove,listStoreClear,)whereimportControl.Monad(liftM,when)importData.IORefimportData.Ix(inRange)#if __GLASGOW_HASKELL__>=606importqualifiedData.SequenceasSeqimportData.Sequence(Seq)importqualifiedData.FoldableasF#elseimportqualifiedGraphics.UI.Gtk.ModelView.SequenceasSeqimportGraphics.UI.Gtk.ModelView.Sequence(Seq)#endifimportGraphics.UI.Gtk.Types(GObjectClass(..),TreeModelClass)importGraphics.UI.Gtk.ModelView.Types(TypedTreeModelClass,TreeIter(..))importGraphics.UI.Gtk.ModelView.CustomStoreimportGraphics.UI.Gtk.ModelView.TreeModelimportGraphics.UI.Gtk.ModelView.TreeDragimportControl.Monad.Trans(liftIO)newtypeListStorea=ListStore(CustomStore(IORef(Seqa))a)instanceTypedTreeModelClassListStoreinstanceTreeModelClass(ListStorea)instanceGObjectClass(ListStorea)wheretoGObject(ListStoretm)=toGObjecttmunsafeCastGObject=ListStore.unsafeCastGObject-- | Create a new 'TreeModel' that contains a list of elements.listStoreNew::[a]->IO(ListStorea)listStoreNewxs=listStoreNewDNDxs(JustlistStoreDefaultDragSourceIface)(JustlistStoreDefaultDragDestIface)-- | Create a new 'TreeModel' that contains a list of elements. In addition, specify two-- interfaces for drag and drop.--listStoreNewDND::[a]-- ^ the initial content of the model->Maybe(DragSourceIfaceListStorea)-- ^ an optional interface for drags->Maybe(DragDestIfaceListStorea)-- ^ an optional interface to handle drops->IO(ListStorea)-- ^ the new modellistStoreNewDNDxsmDSourcemDDest=dorows<-newIORef(Seq.fromListxs)customStoreNewrowsListStoreTreeModelIface{treeModelIfaceGetFlags=return[TreeModelListOnly],treeModelIfaceGetIter=\[n]->readIORefrows>>=\rows->return(ifSeq.nullrowsthenNothingelseJust(TreeIter0(fromIntegraln)00)),treeModelIfaceGetPath=\(TreeIter_n__)->return[fromIntegraln],treeModelIfaceGetRow=\(TreeIter_n__)->readIORefrows>>=\rows->ifinRange(0,Seq.lengthrows-1)(fromIntegraln)thenreturn(rows`Seq.index`fromIntegraln)elsefail"ListStore.getRow: iter does not refer to a valid entry",treeModelIfaceIterNext=\(TreeIter_n__)->readIORefrows>>=\rows->ifinRange(0,Seq.lengthrows-1)(fromIntegral(n+1))thenreturn(Just(TreeIter0(n+1)00))elsereturnNothing,treeModelIfaceIterChildren=\_->returnNothing,treeModelIfaceIterHasChild=\_->returnFalse,treeModelIfaceIterNChildren=\index->readIORefrows>>=\rows->caseindexofNothing->return$!Seq.lengthrows_->return0,treeModelIfaceIterNthChild=\indexn->caseindexofNothing->return(Just(TreeIter0(fromIntegraln)00))_->returnNothing,treeModelIfaceIterParent=\_->returnNothing,treeModelIfaceRefNode=\_->return(),treeModelIfaceUnrefNode=\_->return()}mDSourcemDDest-- | Convert a 'TreeIter' to an an index into the 'ListStore'. Note that this-- function merely extracts the second element of the 'TreeIter'.listStoreIterToIndex::TreeIter->IntlistStoreIterToIndex(TreeIter_n__)=fromIntegraln-- | Default drag functions for 'Graphics.UI.Gtk.ModelView.ListStore'. These-- functions allow the rows of the model to serve as drag source. Any row is-- allowed to be dragged and the data set in the 'SelectionDataM' object is-- set with 'treeSetRowDragData', i.e. it contains the model and the-- 'TreePath' to the row.listStoreDefaultDragSourceIface::DragSourceIfaceListStorerowlistStoreDefaultDragSourceIface=DragSourceIface{treeDragSourceRowDraggable=\__->returnTrue,treeDragSourceDragDataGet=treeSetRowDragData,treeDragSourceDragDataDelete=\model(dest:_)->doliftIO$listStoreRemovemodeldestreturnTrue}-- | Default drop functions for 'Graphics.UI.Gtk.ModelView.ListStore'. These-- functions accept a row and insert the row into the new location if it is-- dragged into a tree view-- that uses the same model.listStoreDefaultDragDestIface::DragDestIfaceListStorerowlistStoreDefaultDragDestIface=DragDestIface{treeDragDestRowDropPossible=\modeldest->domModelPath<-treeGetRowDragDatacasemModelPathofNothing->returnFalseJust(model',source)->return(toTreeModelmodel==toTreeModelmodel'),treeDragDestDragDataReceived=\model(dest:_)->domModelPath<-treeGetRowDragDatacasemModelPathofNothing->returnFalseJust(model',(source:_))->iftoTreeModelmodel/=toTreeModelmodel'thenreturnFalseelseliftIO$dorow<-listStoreGetValuemodelsourcelistStoreInsertmodeldestrowreturnTrue}-- | Extract the value at the given index.--listStoreGetValue::ListStorea->Int->IOalistStoreGetValue(ListStoremodel)index=readIORef(customStoreGetPrivatemodel)>>=return.(`Seq.index`index)-- | Update the value at the given index. The index must exist.--listStoreSetValue::ListStorea->Int->a->IO()listStoreSetValue(ListStoremodel)indexvalue=domodifyIORef(customStoreGetPrivatemodel)(Seq.updateindexvalue)treeModelRowChangedmodel[index](TreeIter0(fromIntegralindex)00)-- | Extract all data from the store.--listStoreToList::ListStorea->IO[a]listStoreToList(ListStoremodel)=liftM#if __GLASGOW_HASKELL__>=606F.toList#elseSeq.toList#endif$readIORef(customStoreGetPrivatemodel)-- | Query the number of elements in the store.listStoreGetSize::ListStorea->IOIntlistStoreGetSize(ListStoremodel)=liftMSeq.length$readIORef(customStoreGetPrivatemodel)-- | Insert an element in front of the given element. The element is appended-- if the index is greater or equal to the size of the list.listStoreInsert::ListStorea->Int->a->IO()listStoreInsert(ListStoremodel)indexvalue=doseq<-readIORef(customStoreGetPrivatemodel)when(index>=0)$doletindex'|index>Seq.lengthseq=Seq.lengthseq|otherwise=indexwriteIORef(customStoreGetPrivatemodel)(insertindex'valueseq)stamp<-customStoreGetStampmodeltreeModelRowInsertedmodel[index'](TreeIterstamp(fromIntegralindex')00)whereinsert::Int->a->Seqa->Seqainsertixxs=frontSeq.><xSeq.<|backwhere(front,back)=Seq.splitAtixs-- | Prepend the element to the store.listStorePrepend::ListStorea->a->IO()listStorePrepend(ListStoremodel)value=domodifyIORef(customStoreGetPrivatemodel)(\seq->valueSeq.<|seq)stamp<-customStoreGetStampmodeltreeModelRowInsertedmodel[0](TreeIterstamp000)-- | Prepend a list to the store. Not implemented yet.listStorePrependList::ListStorea->[a]->IO()listStorePrependListstorelist=mapM_(listStoreInsertstore0)(reverselist)-- | Append an element to the store. Returns the index of the inserted-- element.listStoreAppend::ListStorea->a->IOIntlistStoreAppend(ListStoremodel)value=doindex<-atomicModifyIORef(customStoreGetPrivatemodel)(\seq->(seqSeq.|>value,Seq.lengthseq))stamp<-customStoreGetStampmodeltreeModelRowInsertedmodel[index](TreeIterstamp(fromIntegralindex)00)returnindex{-
listStoreAppendList :: ListStore a -> [a] -> IO ()
listStoreAppendList (ListStore model) values = do
seq <- readIORef (customStoreGetPrivate model)
let seq' = Seq.fromList values
startIndex = Seq.length seq
endIndex = startIndex + Seq.length seq' - 1
writeIORef (customStoreGetPrivate model) (seq Seq.>< seq')
stamp <- customStoreGetStamp model
flip mapM [startIndex..endIndex] $ \index ->
treeModelRowInserted model [index] (TreeIter stamp (fromIntegral index) 0 0)
-}-- | Remove the element at the given index.--listStoreRemove::ListStorea->Int->IO()listStoreRemove(ListStoremodel)index=doseq<-readIORef(customStoreGetPrivatemodel)when(index>=0&&index<Seq.lengthseq)$dowriteIORef(customStoreGetPrivatemodel)(deleteindexseq)treeModelRowDeletedmodel[index]wheredelete::Int->Seqa->Seqadeleteixs=frontSeq.><Seq.drop1backwhere(front,back)=Seq.splitAtixs-- | Empty the store.listStoreClear::ListStorea->IO()listStoreClear(ListStoremodel)=-- Since deleting rows can cause callbacks (eg due to selection changes)-- we have to make sure the model is consitent with the view at each-- intermediate step of clearing the store. Otherwise at some intermediate-- stage when the view has only been informed about some delections, the-- user might query the model expecting to find the remaining rows are there-- but find them deleted. That'd be bad.--letloop(-1)Seq.EmptyR=return()loopn(seqSeq.:>_)=dowriteIORef(customStoreGetPrivatemodel)seqtreeModelRowDeletedmodel[n]loop(n-1)(Seq.viewrseq)indoseq<-readIORef(customStoreGetPrivatemodel)loop(Seq.lengthseq-1)(Seq.viewrseq)-- | Permute the rows of the store. Not yet implemented.listStoreReorder::ListStorea->[Int]->IO()listStoreReorderstore=undefined-- | Swap two rows of the store. Not yet implemented.listStoreSwap::ListStorea->Int->Int->IO()listStoreSwapstore=undefined-- | Move the element at the first index in front of the element denoted by-- the second index. Not yet implemented.listStoreMoveBefore::ListStorea->Int->Int->IO()listStoreMoveBeforestore=undefined-- | Move the element at the first index past the element denoted by the-- second index. Not yet implemented.listStoreMoveAfter::ListStorea->Int->Int->IO()listStoreMoveAfterstore=undefined