GtkUtils.hs revision 2f1781ab0a0a58328ef9d1ad8bda1984fd80259d
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian MaederModule : $Header$
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian MaederDescription : Access to the .glade files stored as strings inside the binary
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederCopyright : (c) Thiemo Wiedemeyer, Uni Bremen 2008
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian MaederMaintainer : raider@informatik.uni-bremen.de
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian MaederStability : provisional
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian MaederPortability : non-portable
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian MaederThis module provides the ability to store xml stings in a temporary file to load
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maederit with gtk2hs. This is needed, because gtk2hs needs glade files for input, but
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maederwe want to distribute them within the binary.
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maeder ( getGladeXML
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder , startMainLoop
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maeder , stopMainLoop
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder , forkIOWithPostProcessing
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder -- * Windows for use inside Gtk thread
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder , errorDialog
fc7df539e6d41b050161ed8f9ae6e444b1b5ab14Christian Maeder , warningDialog
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maeder , questionDialog
2b9022bd5dfb351d1d80f61680336effeccfa23eChristian Maeder , fileOpenDialog
2b9022bd5dfb351d1d80f61680336effeccfa23eChristian Maeder , fileSaveDialog
2b9022bd5dfb351d1d80f61680336effeccfa23eChristian Maeder , listChoiceAux
f9a73de15ef09dbd6b391c7b1f695c79b4446fe2Christian Maeder , progressBar
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , displayTheory
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , displayTheoryWithWarning
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder -- * Windows for use in Gtk windows
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , infoDialogExt
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , errorDialogExt
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , warningDialogExt
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , questionDialogExt
cc8b603388a7deb7fb8045db0341f550f8be5844Christian Maeder , fileOpenDialogExt
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder , fileSaveDialogExt
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder , listChoiceExt
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder , progressBarExt
04dada28736b4a237745e92063d8bdd49a362debChristian Maeder , pulseBarExt
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder , textViewExt
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder , displayTheoryExt
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder , displayTheoryWithWarningExt
04dada28736b4a237745e92063d8bdd49a362debChristian Maeder -- * Frequently used functions inside Gtk thread
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian Maeder , setListData
cf5149eb4d0faef6272231879c04aa740f5abc2bChristian Maeder , updateListData
cf5149eb4d0faef6272231879c04aa740f5abc2bChristian Maeder , setListSelectorSingle
cf5149eb4d0faef6272231879c04aa740f5abc2bChristian Maeder , setListSelectorMultiple
cf5149eb4d0faef6272231879c04aa740f5abc2bChristian Maeder , selectFirst
cf5149eb4d0faef6272231879c04aa740f5abc2bChristian Maeder , getSelectedSingle
cf5149eb4d0faef6272231879c04aa740f5abc2bChristian Maeder , getSelectedMultiple
2b9022bd5dfb351d1d80f61680336effeccfa23eChristian Maeder , selectInvert
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder -- * Datatypes and functions for prover
04dada28736b4a237745e92063d8bdd49a362debChristian Maeder , GStatus (..)
ce5ff829db5f0bb4f16ad4de150eed4401d6acd5Christian Maeder , proofStatusToGStatus
7dec34aee2b609b9535c48d060e0f7baf3536457Christian Maeder , basicProofToGStatus
d17834302eaa101395b4b806cd73670fd864445fChristian Maeder , genericConfigToGStatus
2b9022bd5dfb351d1d80f61680336effeccfa23eChristian Maederimport qualified GUI.Glade.Utils as Utils
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maederimport Data.Maybe (fromMaybe)
7dec34aee2b609b9535c48d060e0f7baf3536457Christian Maederimport System.Directory ( removeFile, getTemporaryDirectory, doesFileExist
bf8221af2a4e579e1a616e3d472e9e8533cd8f8cChristian Maeder , canonicalizePath)
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maederimport System.FilePath (takeFileName, takeDirectory)
7dec34aee2b609b9535c48d060e0f7baf3536457Christian Maederimport System.IO (hFlush, hClose, hPutStr, openTempFile)
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maeder-- | Returns a GladeXML Object of a xmlstring.
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian MaedergetGladeXML :: (String, String) -> IO GladeXML
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian MaedergetGladeXML (name, xmlstr) = do
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maeder temp <- getTemporaryDirectory
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian Maeder (filename, handle) <- openTempFile temp name
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian Maeder hPutStr handle xmlstr
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder hFlush handle
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder mxml <- xmlNew filename
cc8b603388a7deb7fb8045db0341f550f8be5844Christian Maeder hClose handle
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder removeFile filename
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder Just xml -> return xml
1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder Nothing -> error "GtkUtils: Can't load xml string."
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder-- | Starts the gtk main event loop in a thread
15c12a3ac049a4528da05b1017b78145f308aeb0Christian MaederstartMainLoop :: IO ()
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian MaederstartMainLoop = forkIO_ $ do
f4741f6b7da52b5417899c8fcbe4349b920b006eChristian Maeder unsafeInitGUIForThreadedRTS
cc8b603388a7deb7fb8045db0341f550f8be5844Christian MaederstopMainLoop :: IO ()
15c12a3ac049a4528da05b1017b78145f308aeb0Christian MaederstopMainLoop = postGUISync mainQuit
cc8b603388a7deb7fb8045db0341f550f8be5844Christian MaederforkIO_ :: IO () -> IO ()
cc8b603388a7deb7fb8045db0341f550f8be5844Christian MaederforkIO_ f = forkIO f >> return ()
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian MaederforkIOWithPostProcessing :: IO a -> (a -> IO ()) -> IO ()
cdaff0507c1b7240e2660dbb311f9c4646a6d14aChristian MaederforkIOWithPostProcessing action post = forkIO_ $ do
cdaff0507c1b7240e2660dbb311f9c4646a6d14aChristian Maeder result <- action
cdaff0507c1b7240e2660dbb311f9c4646a6d14aChristian Maeder postGUIAsync $ post result
e92ae8b45c138b6cf7db8b69e2d099d7f62f24f0Christian Maeder{- * Usefull windows and function.
d3bca27d616c5741d0b18776c8a0848ec31c87f4Christian Maeder !!! IMPORTANT for all following functions !!!
f9a73de15ef09dbd6b391c7b1f695c79b4446fe2Christian Maeder Functions for use outside of the Gtk thread have a "Ext" postfix.
ac19f8695aa1b2d2d1cd1319da2530edd8f46a96Christian Maeder All other functions must be called from inside the Gtk thread. -}
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder-- | Dialog for different typed messages
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maederdialog :: MessageType -- ^ Dialogtype
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder -> String -- ^ Title
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder -> String -- ^ Message
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder -> Maybe (IO()) -- ^ Action on Ok, Yes
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maederdialog messageType title message mAction = do
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder dlg <- case messageType of
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder MessageInfo ->
8338fbf3cfb9cf981261d893286f070bd9fa17efChristian Maeder messageDialogNew Nothing [] messageType ButtonsOk message
355a453397fa18360bbaeb0f1068ad6a299a1dffChristian Maeder MessageWarning ->
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder messageDialogNew Nothing [] messageType ButtonsYesNo message
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder MessageQuestion ->
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder messageDialogNew Nothing [] messageType ButtonsYesNo message
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder messageDialogNew Nothing [] messageType ButtonsOk message
8338fbf3cfb9cf981261d893286f070bd9fa17efChristian Maeder windowSetTitle dlg title
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder response <- dialogRun dlg
355a453397fa18360bbaeb0f1068ad6a299a1dffChristian Maeder choice <- case response of
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder ResponseOk -> return True
355a453397fa18360bbaeb0f1068ad6a299a1dffChristian Maeder ResponseYes -> return True
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder _ -> return False
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder widgetDestroy dlg
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder when choice $ fromMaybe (return ()) mAction
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder return choice
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder-- | create a window which displays a given text
15c12a3ac049a4528da05b1017b78145f308aeb0Christian MaederinfoDialog :: String -- ^ Title
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder -> String -- ^ Message
20fe556546c9277cf017931a07d90add61f199d9Christian MaederinfoDialog title message = do
b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder dialog MessageInfo title message Nothing
b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder-- | create a window which displays a given text
20fe556546c9277cf017931a07d90add61f199d9Christian MaederinfoDialogExt :: String -- ^ Title
20fe556546c9277cf017931a07d90add61f199d9Christian Maeder -> String -- ^ Message
20fe556546c9277cf017931a07d90add61f199d9Christian MaederinfoDialogExt title = postGUISync . infoDialog title
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder-- | create a window which displays a given error
b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian MaedererrorDialog :: String -- ^ Title
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maeder -> String -- ^ Message
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian MaedererrorDialog title message = do
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder dialog MessageError title message Nothing
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder-- | create a window which displays a given error
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian MaedererrorDialogExt :: String -- ^ Title
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder -> String -- ^ Message
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian MaedererrorDialogExt title = postGUISync . errorDialog title
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder-- | create a window which displays a given warning and ask for continue
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian MaederwarningDialog :: String -- ^ Title
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian Maeder -> String -- ^ Message
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian Maeder -> Maybe (IO ()) -- ^ Action on Ok
15c12a3ac049a4528da05b1017b78145f308aeb0Christian MaederwarningDialog = dialog MessageWarning
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder-- | create a window which displays a given warning and ask for continue
15c12a3ac049a4528da05b1017b78145f308aeb0Christian MaederwarningDialogExt :: String -- ^ Title
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder -> String -- ^ Message
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder -> Maybe (IO ()) -- ^ Action on Ok
278de8173a1b7b7f6299f7c804135d14560176daChristian MaederwarningDialogExt title message = postGUISync . warningDialog title message
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder-- | create a window which displays a given question
15c12a3ac049a4528da05b1017b78145f308aeb0Christian MaederquestionDialog :: String -- ^ Title
15c12a3ac049a4528da05b1017b78145f308aeb0Christian Maeder -> String -- ^ Message
278de8173a1b7b7f6299f7c804135d14560176daChristian Maeder -> Maybe (IO ()) -- ^ Action on Yes
e76e6a43f51438215737d6fc176c89da05bb86daChristian MaederquestionDialog = dialog MessageQuestion
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder-- | create a window which displays a given question
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian MaederquestionDialogExt :: String -- ^ Title
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maeder -> String -- ^ Message
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder -> Maybe (IO ()) -- ^ Action on Yes
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaederquestionDialogExt title message = postGUISync . questionDialog title message
04dada28736b4a237745e92063d8bdd49a362debChristian Maeder-- | Filedialog for opening and saving
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian MaederfileDialog :: FileChooserAction -- ^ Action
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder -> FilePath -- ^ Defaultname for file
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder -> [(String, [String])] -- ^ Filter (name, pattern list)
f626b1acbe874a48143a6f8d6246bf9d7a055ffbChristian Maeder -> Maybe (FilePath -> IO ()) -- ^ Action on open
04dada28736b4a237745e92063d8bdd49a362debChristian Maeder -> IO (Maybe FilePath)
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian MaederfileDialog fAction fname' filters mAction = do
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder fname <- canonicalizePath fname'
3f63b98c111e5e2bb2cf13795cf6e084a78b0a8dChristian Maeder dlg <- case fAction of
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder FileChooserActionOpen -> do
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder dlg' <-fileChooserDialogNew Nothing Nothing FileChooserActionOpen
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder [ (stockCancel, ResponseCancel)
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , (stockOpen, ResponseAccept)]
8338fbf3cfb9cf981261d893286f070bd9fa17efChristian Maeder fileChooserSetCurrentFolder dlg' $ takeDirectory fname
8338fbf3cfb9cf981261d893286f070bd9fa17efChristian Maeder fileChooserSetFilename dlg' $ takeFileName fname
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder FileChooserActionSave -> do
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder dlg' <- fileChooserDialogNew Nothing Nothing FileChooserActionSave
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder [ (stockCancel, ResponseCancel)
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder , (stockSave, ResponseAccept)]
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder fileChooserSetCurrentFolder dlg' $ takeDirectory fname
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder fileChooserSetCurrentName dlg' $ takeFileName fname
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder _ -> error "FileDialog: Wrong Type"
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder mapM_ (\ (name, pattern) -> do
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder fileFilter <- fileFilterNew
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder mapM_ (fileFilterAddPattern fileFilter) pattern
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder fileFilterSetName fileFilter name
0f67ca7b0c738a28f6688ba6e96d44d7c14af611Christian Maeder fileChooserAddFilter dlg fileFilter
xml <- getGladeXML Utils.get
-- | Progress/Pulse bar window
xml <- getGladeXML Utils.get
xml <- getGladeXML Utils.get