Menu
▾
▴
[htoolkit-cvs] port/src/Port Document.hs,1.1,1.2
|
From: <kr_...@us...> - 2003-07-26 20:01:52
|
Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv32203/src/Port
Modified Files:
Document.hs
Log Message:
New document template
Index: Document.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Document.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Document.hs 14 Mar 2003 15:26:10 -0000 1.1
--- Document.hs 26 Jul 2003 20:01:50 -0000 1.2
***************
*** 1,78 ****
! {-# OPTIONS -fglasgow-exts #-}
! -----------------------------------------------------------------------------------------
! {-| Module : Document
! Copyright : (c) Krasimir Angelov 2003
! License : BSD-style
!
! Maintainer : ka2...@ya...
! Stability : provisional
! Portability : portable
!
! Documents
! -}
! -----------------------------------------------------------------------------------------
!
! module Graphics.UI.Port.Document
! (
! -- * Document templates
! DocumentTemplate(..), registerDocTemplate
! -- * Documents
! , registerDocument, unregisterDocument, setDocumentModified
! )where
!
! import Graphics.UI.Port.Types
! import Graphics.UI.Port.PtrMap
! import Control.Concurrent.MVar
! import System.IO.Unsafe( unsafePerformIO )
!
! data Document = forall a . Document a (DocumentTemplate a) Bool
!
! data DocumentTemplate a = DocumentTemplate
! { dtExtensions :: [String]
! , dtDescription :: String
! , dtNewDocument :: IO a
! , dtOpenDocument :: String -> IO a
! , dtSaveDocument :: a -> IO ()
! , dtSaveDocumentAs :: String -> a -> IO ()
! , dtCloseDocument :: a -> IO ()
! }
!
! data DTHolder = forall a . DTHolder (DocumentTemplate a)
!
! {-----------------------------------------------------------------------------------------
! Document templeates
! -----------------------------------------------------------------------------------------}
!
! {-# NOINLINE documentTemplates #-}
! documentTemplates :: MVar [DTHolder]
! documentTemplates = unsafePerformIO (newMVar [])
!
! registerDocTemplate :: DocumentTemplate a -> IO ()
! registerDocTemplate template = do
! templates <- takeMVar documentTemplates
! putMVar documentTemplates ((DTHolder template):templates)
!
! {-----------------------------------------------------------------------------------------
! Documents
! -----------------------------------------------------------------------------------------}
!
! {-# NOINLINE documents #-}
! documents :: MVar (PtrMap WindowHandle Document)
! documents = unsafePerformIO (newMVar empty)
!
! registerDocument :: WindowHandle -> a -> DocumentTemplate a -> IO ()
! registerDocument handle doc template = do
! docs <- takeMVar documents
! putMVar documents (insertWith const handle (Document doc template False) docs)
!
! unregisterDocument :: WindowHandle -> a -> DocumentTemplate a -> IO ()
! unregisterDocument handle doc template = do
! docs <- takeMVar documents
! putMVar documents (delete handle docs)
!
! setDocumentModified :: WindowHandle -> Bool -> IO ()
! setDocumentModified handle flag = do
! docs <- takeMVar documents
! putMVar documents (adjust upd handle docs)
! where
! upd (Document doc template _) = Document doc template flag
--- 1,162 ----
! {-# OPTIONS -fglasgow-exts #-}
! -----------------------------------------------------------------------------------------
! {-| Module : Document
! Copyright : (c) Krasimir Angelov 2003
! License : BSD-style
!
! Maintainer : ka2...@ya...
! Stability : provisional
! Portability : portable
!
! Documents
! -}
! -----------------------------------------------------------------------------------------
!
! module Graphics.UI.Port.Document
! (
! -- * Document templates
! DocumentTemplate(..), registerDocTemplate, clearDocTemplates
! -- * Documents
! , registerDocument, unregisterDocument
! , readDoc, writeDoc
! , getDocModified, getDocFilePath
! , newDoc, openDoc, saveDoc
! , openDocWindow, printDoc
! )where
!
! import Data.IORef
! import Graphics.UI.Port.Types
! import Graphics.UI.Port.PtrMap
! import Control.Concurrent.MVar
! import Control.Monad
! import System.IO.Unsafe( unsafePerformIO )
!
! data Document a = Document
! { docReference :: !(IORef (Bool,a)) -- reference to pair of the document value and the flag for modification
! , docFilePath :: !(IORef (Either FilePath Int)) -- reference to the current file path for the document
! , docWindowsList :: !(IORef [WindowHandle]) -- reference to the list of windows that uses this document
! , docTemplate :: DocumentTemplate a -- the template
! }
!
! data DocumentTemplate a = DocumentTemplate
! { dtMimeType :: String
! , dtOrder :: Int
! , dtDescription :: String
! , dtExtensions :: [String]
! , dtNewDocument :: IO a
! , dtOpenDocument :: FilePath -> IO a
! , dtSaveDocument :: FilePath -> a -> IO ()
! , dtPrintDocument :: a -> IO ()
! , dtOpenWindow :: Document a -> IO WindowHandle
! , dtCompatibleTemplates :: [String]
! }
!
! data Holder w = forall a . Holder (w a)
!
! -----------------------------------------------------------------------------------------
! -- Document templeates
! -----------------------------------------------------------------------------------------
!
! {-# NOINLINE documentTemplates #-}
! documentTemplates :: MVar [Holder DocumentTemplate]
! documentTemplates = unsafePerformIO (newMVar [])
!
! registerDocTemplate :: DocumentTemplate a -> IO ()
! registerDocTemplate template = do
! templates <- takeMVar documentTemplates
! putMVar documentTemplates ((Holder template):templates)
!
! clearDocTemplates :: IO ()
! clearDocTemplates = do
! templates <- takeMVar documentTemplates
! putMVar documentTemplates []
!
! -----------------------------------------------------------------------------------------
! -- Documents
! -----------------------------------------------------------------------------------------
!
! {-# NOINLINE documents #-}
! documents :: MVar (PtrMap WindowHandle (Holder Document))
! documents = unsafePerformIO (newMVar empty)
!
! registerDocument :: WindowHandle -> Document a -> IO ()
! registerDocument handle doc = do
! docs <- takeMVar documents
! putMVar documents (insert handle (Holder doc) docs)
!
! unregisterDocument :: WindowHandle -> IO ()
! unregisterDocument handle = do
! docs <- takeMVar documents
! putMVar documents (delete handle docs)
!
! -----------------------------------------------------------------------------------------
! -- Operations on documents
! -----------------------------------------------------------------------------------------
!
! readDoc :: Document a -> IO a
! readDoc (Document ref _ _ _) = do
! (modified, x) <- readIORef ref
! return x
!
! writeDoc :: Document a -> a -> IO ()
! writeDoc (Document ref _ refWindows _) x = do
! (modified, _) <- readIORef ref
! when (not modified) (readIORef refWindows >>= mapM_ (updateWindowModifiedState True))
! writeIORef ref (True,x)
!
! getDocModified :: Document a -> IO Bool
! getDocModified (Document ref _ _ _) = do
! (modified, x) <- readIORef ref
! return modified
!
! getDocFilePath :: Document a -> IO (Maybe FilePath)
! getDocFilePath (Document _ refPath _ _) = do
! path <- readIORef refPath
! return (case path of {Left path -> Just path; Right _ -> Nothing})
!
! newDoc :: DocumentTemplate a -> IO (Document a)
! newDoc templ = do
! x <- dtNewDocument templ
! index <- withMVar documents (getNextDocumentIndex templ . elems)
! ref <- newIORef (False, x)
! refPath <- newIORef (Right index)
! refWindows <- newIORef []
! return (Document ref refPath refWindows templ)
!
! openDoc :: FilePath -> DocumentTemplate a -> IO (Document a)
! openDoc path templ = do
! x <- dtOpenDocument templ path
! ref <- newIORef (False, x)
! refPath <- newIORef (Left path)
! refWindows <- newIORef []
! return (Document ref refPath refWindows templ)
!
! saveDoc :: FilePath -> Document a -> IO ()
! saveDoc path (Document ref refPath refWindows templ) = do
! (modified, x) <- readIORef ref
! when modified $ do
! dtSaveDocument templ path x
! readIORef refWindows >>= mapM_ (updateWindowModifiedState False)
! writeIORef ref (False, x)
! writeIORef refPath (Left path)
!
! openDocWindow :: Document a -> IO WindowHandle
! openDocWindow d@(Document _ _ _ templ) = dtOpenWindow templ d
!
! printDoc :: Document a -> IO ()
! printDoc (Document ref _ _ templ) = do
! (modified, x) <- readIORef ref
! dtPrintDocument templ x
!
! updateWindowModifiedState :: Bool -> WindowHandle -> IO ()
! updateWindowModifiedState flag hwnd = return () -- TODO
!
! getNextDocumentIndex :: DocumentTemplate a -> [Holder Document] -> IO Int
! getNextDocumentIndex dt [] = return 0
! getNextDocumentIndex dt (Holder doc : docs) = do
! path <- readIORef (docFilePath doc)
! case path of
! Right index | dtMimeType (docTemplate doc) == dtMimeType dt -> do
! index' <- getNextDocumentIndex dt docs
! return (max (index+1) index')
! _ -> getNextDocumentIndex dt docs
|
