[htoolkit-cvs] port/src/Port FileDialog.hs,1.2,1.3

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv4266/port/src/Port

Modified Files:
	FileDialog.hs 
Log Message:
The InputFileDialog, OutputFileDialog and SelectDirectory dialogs has extended functionality


Index: FileDialog.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/FileDialog.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** FileDialog.hs	21 Jan 2003 22:01:09 -0000	1.2
--- FileDialog.hs	26 Apr 2003 10:00:46 -0000	1.3
***************
*** 16,25 ****
               runDirectoryDialog
             , runInputFileDialog
             , runOutputFileDialog
             ) where
  
  import Foreign.C
- import Foreign.Ptr
- import Foreign.Marshal.Alloc
  import Graphics.UI.Port.Types
  
--- 16,25 ----
               runDirectoryDialog
             , runInputFileDialog
+            , runInputFilesDialog
             , runOutputFileDialog
             ) where
  
+ import Foreign
  import Foreign.C
  import Graphics.UI.Port.Types
  
***************
*** 28,53 ****
  -----------------------------------------------------------------------------------------}
  -- | Run a dialog to select an input file. Returns 'Nothing' when cancelled.
! runInputFileDialog :: IO (Maybe String)
! runInputFileDialog
!   = do cin <- osSelectInputFile
         maybeCString cin
! foreign import ccall osSelectInputFile :: IO CString
  
! -- | Run a dialog to select an output file. Takes both a prompt message and a 
  -- suggested filename as arguments. Returns 'Nothing' when cancelled.
! runOutputFileDialog :: String -> String -> IO (Maybe String)
! runOutputFileDialog msg fname
!   = withCString msg $ \cmsg ->
      withCString fname $ \cname ->
!     do cout <- osSelectOutputFile cmsg cname
         maybeCString cout
! foreign import ccall osSelectOutputFile :: CString -> CString -> IO CString
  
  -- | Runs a dialog to select a directory. Returns 'Nothing' when cancelled.
! runDirectoryDialog :: IO (Maybe String)
! runDirectoryDialog
!   = do cdir <- osSelectDirectory
         maybeCString cdir
! foreign import ccall osSelectDirectory :: IO CString
  
  
--- 28,65 ----
  -----------------------------------------------------------------------------------------}
  -- | Run a dialog to select an input file. Returns 'Nothing' when cancelled.
! runInputFileDialog :: String -> [(String,[String])] -> IO (Maybe FilePath)
! runInputFileDialog title filter
!   = withCString title $ \ctitle ->
!     withCFilter filter $ \cfilter ->
!     do cin <- osSelectInputFile ctitle cfilter
         maybeCString cin
! foreign import ccall osSelectInputFile :: CString -> Ptr CChar -> IO CString
  
! -- | Run a dialog to select multiple input files. Returns empty list when canceled.
! runInputFilesDialog :: String -> [(String,[String])] -> IO [FilePath]
! runInputFilesDialog title filter
!   = withCString title $ \ctitle ->
!     withCFilter filter $ \cfilter ->
!     do cin <- osSelectInputFiles ctitle cfilter
!        peekCStrings cin
! foreign import ccall osSelectInputFiles :: CString -> Ptr CChar -> IO (Ptr CChar)
! 
! -- | Run a dialog to select an output file. Takes both a dialog title and a 
  -- suggested filename as arguments. Returns 'Nothing' when cancelled.
! runOutputFileDialog :: String -> [(String,[String])] -> FilePath -> IO (Maybe FilePath)
! runOutputFileDialog title filter fname
!   = withCString title $ \ctitle ->
      withCString fname $ \cname ->
!     withCFilter filter $ \cfilter ->
!     do cout <- osSelectOutputFile ctitle cfilter cname
         maybeCString cout
! foreign import ccall osSelectOutputFile :: CString -> Ptr CChar -> CString -> IO CString
  
  -- | Runs a dialog to select a directory. Returns 'Nothing' when cancelled.
! runDirectoryDialog :: String -> IO (Maybe FilePath)
! runDirectoryDialog title
!   = do cdir <- withCString title osSelectDirectory
         maybeCString cdir
! foreign import ccall osSelectDirectory :: CString -> IO CString
  
  
***************
*** 55,57 ****
  maybeCString cstr
    | cstr == nullPtr = return Nothing
!   | otherwise       = do str <- peekCString cstr; free cstr; return (Just str)
\ No newline at end of file
--- 67,94 ----
  maybeCString cstr
    | cstr == nullPtr = return Nothing
!   | otherwise       = do str <- peekCString cstr; free cstr; return (Just str)
!   
! withCFilter :: [(String,[String])] -> (Ptr CChar -> IO a) -> IO a
! withCFilter filter io = 
!   let filterSize []               = 2
!       filterSize ((name,exts):rs) = (length name+1)+(foldr (\x n -> length x+1+n) 0 exts)+filterSize rs
!       
!       pokeFilter []               cfilter = do
!         pokeElemOff cfilter 0 (castCharToCChar '\0')
!         pokeElemOff cfilter 1 (castCharToCChar '\0')
!       pokeFilter ((name,exts):rs) cfilter = do
!         pokeArray0 (castCharToCChar '\0') cfilter (map castCharToCChar name)
!         cfilter <- pokeExts name exts (cfilter `plusPtr` (length name+1))
!         pokeFilter rs cfilter
!         
!       pokeExts name []    cfilter = error ("Filter \"" ++ name ++ "\" has empty list of file extensions")
!       pokeExts name [ext] cfilter = do
!         pokeArray0 (castCharToCChar '\0') cfilter (map castCharToCChar ext)
!         return (cfilter `plusPtr` (length ext+1))
!       pokeExts name (ext:exts) cfilter = do
!         pokeArray0 (castCharToCChar ';')  cfilter (map castCharToCChar ext)
!         pokeExts name exts (cfilter `plusPtr` (length ext+1))
!   in
!       allocaArray (filterSize filter) $ \cfilter -> do
!         pokeFilter filter cfilter
!         io cfilter