|
From: <kr_...@us...> - 2003-04-26 10:01:22
|
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
|