{-# LANGUAGE CPP #-}
{- |
Module      :  ./GUI/GtkUtils.hs
Description :  Access to the .glade files stored as strings inside the binary
Copyright   :  (c) Thiemo Wiedemeyer, Uni Bremen 2008
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  raider@informatik.uni-bremen.de
Stability   :  provisional
Portability :  non-portable

This module provides the ability to store xml stings in a temporary file to load
it with gtk2hs. This is needed, because gtk2hs needs glade files for input, but
we want to distribute them within the binary.
-}

module GUI.GtkUtils
  ( getGTKBuilder
  , startMainLoop
  , stopMainLoop
  , forkIO_
  , forkIOWithPostProcessing

  -- * Windows for use inside Gtk thread
  , infoDialog
  , errorDialog
  , warningDialog
  , questionDialog

  , fileOpenDialog
  , fileSaveDialog

  , listChoiceAux
  , listChoice

  , progressBar
  , pulseBar

  , textView
  , displayTheoryWithWarning

  -- * Windows for use in Gtk windows
  , infoDialogExt
  , errorDialogExt
  , warningDialogExt
  , questionDialogExt

  , fileOpenDialogExt
  , fileSaveDialogExt

  , listChoiceExt

  , progressBarExt
  , pulseBarExt

  , textViewExt
  , displayTheoryWithWarningExt

  -- * Frequently used functions inside Gtk thread
  , setListData
  , updateListData
  , setListSelectorSingle
  , setListSelectorMultiple
  , selectFirst
  , getSelectedSingle
  , getSelectedMultiple

  , selectAllRows

  , activate

  , escapeGtkMarkup
  , ComboBoxText
  , toComboBoxText
  ) where

import Graphics.UI.Gtk

import qualified GUI.Glade.Utils as Utils

import Static.GTheory

import Common.DocUtils (showDoc)
import Common.IO

import Control.Concurrent (forkIO)
import Control.Monad (when)

import qualified Data.Text as Text

import System.Directory ( doesFileExist
                        , canonicalizePath)
import System.FilePath (takeFileName, takeDirectory)

-- | Returns a GladeXML Object of a xmlstring.
getGTKBuilder :: (String, String) -> IO Builder
getGTKBuilder :: (String, String) -> IO Builder
getGTKBuilder (_, xmlstr :: String
xmlstr) = do
  Builder
builder <- IO Builder
builderNew
  Builder -> String -> IO ()
forall string. GlibString string => Builder -> string -> IO ()
builderAddFromString Builder
builder String
xmlstr
  Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
builder

-- | Starts the gtk main event loop in a thread
startMainLoop :: IO ()
startMainLoop :: IO ()
startMainLoop = IO () -> IO ()
forkIO_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  IO [String]
unsafeInitGUIForThreadedRTS
  IO ()
mainGUI

stopMainLoop :: IO ()
stopMainLoop :: IO ()
stopMainLoop = IO () -> IO ()
forall a. IO a -> IO a
postGUISync IO ()
mainQuit

forkIO_ :: IO () -> IO ()
forkIO_ :: IO () -> IO ()
forkIO_ f :: IO ()
f = IO () -> IO ThreadId
forkIO IO ()
f IO ThreadId -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

forkIOWithPostProcessing :: IO a -> (a -> IO ()) -> IO ()
forkIOWithPostProcessing :: IO a -> (a -> IO ()) -> IO ()
forkIOWithPostProcessing action :: IO a
action post :: a -> IO ()
post = IO () -> IO ()
forkIO_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a
action IO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> IO ()
postGUIAsync (IO () -> IO ()) -> (a -> IO ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
post

escapeGtkMarkup :: String -> String
escapeGtkMarkup :: String -> String
escapeGtkMarkup = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> String) -> String -> String)
-> (Char -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ \ c :: Char
c -> case Char
c of
  '<' -> "&lt;"
  '>' -> "&gt;"
  '&' -> "&amp;"
  _ -> [Char
c]

{- * Usefull windows and function.
     !!! IMPORTANT for all following functions !!!
     Functions for use outside of the Gtk thread have a "Ext" postfix.
     All other functions must be called from inside the Gtk thread. -}

-- | Dialog for different typed messages
dialog :: MessageType -- ^ Dialogtype
       -> String -- ^ Title
       -> String -- ^ Message
       -> IO Bool
dialog :: MessageType -> String -> String -> IO Bool
dialog messageType :: MessageType
messageType title :: String
title message :: String
message = do
  MessageDialog
dlg <- case MessageType
messageType of
    MessageInfo ->
      Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> String
-> IO MessageDialog
forall string.
GlibString string =>
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNew Maybe Window
forall a. Maybe a
Nothing [] MessageType
messageType ButtonsType
ButtonsOk String
message
    MessageWarning ->
      Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> String
-> IO MessageDialog
forall string.
GlibString string =>
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNew Maybe Window
forall a. Maybe a
Nothing [] MessageType
messageType ButtonsType
ButtonsYesNo String
message
    MessageQuestion ->
      Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> String
-> IO MessageDialog
forall string.
GlibString string =>
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNew Maybe Window
forall a. Maybe a
Nothing [] MessageType
messageType ButtonsType
ButtonsYesNo String
message
    _ ->
      Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> String
-> IO MessageDialog
forall string.
GlibString string =>
Maybe Window
-> [DialogFlags]
-> MessageType
-> ButtonsType
-> string
-> IO MessageDialog
messageDialogNew Maybe Window
forall a. Maybe a
Nothing [] MessageType
messageType ButtonsType
ButtonsOk String
message

  MessageDialog -> String -> IO ()
forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetTitle MessageDialog
dlg String
title

  ResponseId
rspns <- MessageDialog -> IO ResponseId
forall self. DialogClass self => self -> IO ResponseId
dialogRun MessageDialog
dlg
  MessageDialog -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetDestroy MessageDialog
dlg

  case ResponseId
rspns of
    ResponseOk -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    ResponseYes -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    _ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | create a window which displays a given text
infoDialog :: String -- ^ Title
           -> String -- ^ Message
           -> IO ()
infoDialog :: String -> String -> IO ()
infoDialog title :: String
title message :: String
message = do
  MessageType -> String -> String -> IO Bool
dialog MessageType
MessageInfo String
title String
message
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | create a window which displays a given text
infoDialogExt :: String -- ^ Title
              -> String -- ^ Message
              -> IO ()
infoDialogExt :: String -> String -> IO ()
infoDialogExt title :: String
title = IO () -> IO ()
forall a. IO a -> IO a
postGUISync (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
infoDialog String
title

-- | create a window which displays a given error
errorDialog :: String -- ^ Title
            -> String -- ^ Message
            -> IO ()
errorDialog :: String -> String -> IO ()
errorDialog title :: String
title message :: String
message = do
  MessageType -> String -> String -> IO Bool
dialog MessageType
MessageError String
title String
message
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | create a window which displays a given error
errorDialogExt :: String -- ^ Title
               -> String -- ^ Message
               -> IO ()
errorDialogExt :: String -> String -> IO ()
errorDialogExt title :: String
title = IO () -> IO ()
forall a. IO a -> IO a
postGUISync (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorDialog String
title

-- | create a window which displays a given warning and ask for continue
warningDialog :: String -- ^ Title
              -> String -- ^ Message
              -> IO Bool
warningDialog :: String -> String -> IO Bool
warningDialog = MessageType -> String -> String -> IO Bool
dialog MessageType
MessageWarning

-- | create a window which displays a given warning and ask for continue
warningDialogExt :: String -- ^ Title
                 -> String -- ^ Message
                 -> IO Bool
warningDialogExt :: String -> String -> IO Bool
warningDialogExt title :: String
title = IO Bool -> IO Bool
forall a. IO a -> IO a
postGUISync (IO Bool -> IO Bool) -> (String -> IO Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO Bool
warningDialog String
title

-- | create a window which displays a given question
questionDialog :: String  -- ^ Title
               -> String  -- ^ Message
               -> IO Bool
questionDialog :: String -> String -> IO Bool
questionDialog = MessageType -> String -> String -> IO Bool
dialog MessageType
MessageQuestion

-- | create a window which displays a given question
questionDialogExt :: String  -- ^ Title
                  -> String  -- ^ Message
                  -> IO Bool
questionDialogExt :: String -> String -> IO Bool
questionDialogExt title :: String
title = IO Bool -> IO Bool
forall a. IO a -> IO a
postGUISync (IO Bool -> IO Bool) -> (String -> IO Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO Bool
questionDialog String
title


-- | Filedialog for opening and saving
fileDialog :: FileChooserAction -- ^ Action
           -> FilePath -- ^ Defaultname for file
           -> [(String, [String])] -- ^ Filter (name, pattern list)
           -> Maybe (FilePath -> IO ()) -- ^ Action on open
           -> IO (Maybe FilePath)
fileDialog :: FileChooserAction
-> String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileDialog fAction :: FileChooserAction
fAction fname' :: String
fname' filters :: [(String, [String])]
filters mAction :: Maybe (String -> IO ())
mAction = do
  String
fname <- String -> IO String -> IO String
forall a. a -> IO a -> IO a
catchIOException String
fname' (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
fname'
  FileChooserDialog
dlg <- case FileChooserAction
fAction of
    FileChooserActionOpen -> do
      FileChooserDialog
dlg' <- Maybe StockId
-> Maybe Window
-> FileChooserAction
-> [(StockId, ResponseId)]
-> IO FileChooserDialog
forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> IO FileChooserDialog
fileChooserDialogNew Maybe StockId
forall a. Maybe a
Nothing Maybe Window
forall a. Maybe a
Nothing FileChooserAction
FileChooserActionOpen
                                  [ (StockId
stockCancel, ResponseId
ResponseCancel)
                                  , (StockId
stockOpen, ResponseId
ResponseAccept)]
      FileChooserDialog -> String -> IO Bool
forall self. FileChooserClass self => self -> String -> IO Bool
fileChooserSetCurrentFolder FileChooserDialog
dlg' (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fname
      FileChooserDialog -> String -> IO Bool
forall self. FileChooserClass self => self -> String -> IO Bool
fileChooserSetFilename FileChooserDialog
dlg' (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
fname
      FileChooserDialog -> IO FileChooserDialog
forall (m :: * -> *) a. Monad m => a -> m a
return FileChooserDialog
dlg'
    FileChooserActionSave -> do
      FileChooserDialog
dlg' <- Maybe StockId
-> Maybe Window
-> FileChooserAction
-> [(StockId, ResponseId)]
-> IO FileChooserDialog
forall string.
GlibString string =>
Maybe string
-> Maybe Window
-> FileChooserAction
-> [(string, ResponseId)]
-> IO FileChooserDialog
fileChooserDialogNew Maybe StockId
forall a. Maybe a
Nothing Maybe Window
forall a. Maybe a
Nothing FileChooserAction
FileChooserActionSave
                                   [ (StockId
stockCancel, ResponseId
ResponseCancel)
                                   , (StockId
stockSave, ResponseId
ResponseAccept)]
      FileChooserDialog -> String -> IO Bool
forall self. FileChooserClass self => self -> String -> IO Bool
fileChooserSetCurrentFolder FileChooserDialog
dlg' (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fname
      FileChooserDialog -> String -> IO ()
forall self fp.
(FileChooserClass self, GlibFilePath fp) =>
self -> fp -> IO ()
fileChooserSetCurrentName FileChooserDialog
dlg' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
fname
      FileChooserDialog -> IO FileChooserDialog
forall (m :: * -> *) a. Monad m => a -> m a
return FileChooserDialog
dlg'
    _ -> String -> IO FileChooserDialog
forall a. HasCallStack => String -> a
error "FileDialog: Wrong Type"

  ((String, [String]) -> IO ()) -> [(String, [String])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (name :: String
name, pattern :: [String]
pattern) -> do
          FileFilter
fileFilter <- IO FileFilter
fileFilterNew
          (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FileFilter -> String -> IO ()
forall string. GlibString string => FileFilter -> string -> IO ()
fileFilterAddPattern FileFilter
fileFilter) [String]
pattern
          FileFilter -> String -> IO ()
forall string. GlibString string => FileFilter -> string -> IO ()
fileFilterSetName FileFilter
fileFilter String
name
          FileChooserDialog -> FileFilter -> IO ()
forall self. FileChooserClass self => self -> FileFilter -> IO ()
fileChooserAddFilter FileChooserDialog
dlg FileFilter
fileFilter
        ) [(String, [String])]
filters

  ResponseId
rspns <- FileChooserDialog -> IO ResponseId
forall self. DialogClass self => self -> IO ResponseId
dialogRun FileChooserDialog
dlg
  Maybe String
ret <- case ResponseId
rspns of
    ResponseCancel -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    ResponseAccept -> do
      Maybe String
mpath <- FileChooserDialog -> IO (Maybe String)
forall self fp.
(FileChooserClass self, GlibFilePath fp) =>
self -> IO (Maybe fp)
fileChooserGetFilename FileChooserDialog
dlg
      case Maybe String
mpath of
        Just path :: String
path -> do
          Bool
exist <- String -> IO Bool
doesFileExist String
path
          Bool
answer <- if Bool
exist then String -> String -> IO Bool
questionDialog "File already exist"
                                    "Are you sure to overwrite existing file?"
            else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          if Bool
answer then
            case Maybe (String -> IO ())
mAction of
              Just action :: String -> IO ()
action -> do
                String -> IO ()
action String
path
                Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mpath
              Nothing -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mpath
            else Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
        Nothing -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    _ -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  FileChooserDialog -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetDestroy FileChooserDialog
dlg
  Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
ret

fileOpenDialog :: FilePath -- ^ Defaultname for file
               -> [(String, [String])] -- ^ Filter (name, pattern list)
               -> Maybe (FilePath -> IO ()) -- ^ Action on open
               -> IO (Maybe FilePath)
fileOpenDialog :: String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileOpenDialog = FileChooserAction
-> String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileDialog FileChooserAction
FileChooserActionOpen

fileOpenDialogExt :: FilePath -- ^ Defaultname for file
                  -> [(String, [String])] -- ^ Filter (name, pattern list)
                  -> Maybe (FilePath -> IO ()) -- ^ Action on open
                  -> IO (Maybe FilePath)
fileOpenDialogExt :: String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileOpenDialogExt p :: String
p f :: [(String, [String])]
f = IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a
postGUISync (IO (Maybe String) -> IO (Maybe String))
-> (Maybe (String -> IO ()) -> IO (Maybe String))
-> Maybe (String -> IO ())
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileOpenDialog String
p [(String, [String])]
f

fileSaveDialog :: FilePath -- ^ Defaultname for file
               -> [(String, [String])] -- ^ Filter (name, pattern list)
               -> Maybe (FilePath -> IO ()) -- ^ Action on save
               -> IO (Maybe FilePath)
fileSaveDialog :: String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileSaveDialog = FileChooserAction
-> String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileDialog FileChooserAction
FileChooserActionSave

fileSaveDialogExt :: FilePath -- ^ Defaultname for file
                  -> [(String, [String])] -- ^ Filter (name, pattern list)
                  -> Maybe (FilePath -> IO ()) -- ^ Action on save
                  -> IO (Maybe FilePath)
fileSaveDialogExt :: String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileSaveDialogExt p :: String
p f :: [(String, [String])]
f = IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a
postGUISync (IO (Maybe String) -> IO (Maybe String))
-> (Maybe (String -> IO ()) -> IO (Maybe String))
-> Maybe (String -> IO ())
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileSaveDialog String
p [(String, [String])]
f

-- | create a window with title and list of options, return selected option
listChoiceAux :: String -- ^ Title
              -> (a -> String) -- ^ Name of element
              -> [a] -- ^ Rows to display
              -> IO (Maybe (Int, a)) -- ^ Selected row
listChoiceAux :: String -> (a -> String) -> [a] -> IO (Maybe (Int, a))
listChoiceAux title :: String
title showF :: a -> String
showF items :: [a]
items = do
  Builder
builder <- (String, String) -> IO Builder
getGTKBuilder (String, String)
Utils.get
  -- get objects
  Dialog
dlg <- Builder -> (GObject -> Dialog) -> String -> IO Dialog
forall cls string.
(GObjectClass cls, GlibString string) =>
Builder -> (GObject -> cls) -> string -> IO cls
builderGetObject Builder
builder GObject -> Dialog
forall obj. GObjectClass obj => obj -> Dialog
castToDialog "ListView"
  TreeView
trvList <- Builder -> (GObject -> TreeView) -> String -> IO TreeView
forall cls string.
(GObjectClass cls, GlibString string) =>
Builder -> (GObject -> cls) -> string -> IO cls
builderGetObject Builder
builder GObject -> TreeView
forall obj. GObjectClass obj => obj -> TreeView
castToTreeView "trvList"

  Dialog -> String -> IO ()
forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetTitle Dialog
dlg String
title
  ListStore a
store <- TreeView -> (a -> String) -> [a] -> IO (ListStore a)
forall a. TreeView -> (a -> String) -> [a] -> IO (ListStore a)
setListData TreeView
trvList a -> String
showF [a]
items
  TreeSelection
selector <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
trvList
  TreeView -> IO () -> IO (ConnectId TreeSelection)
setListSelectorSingle TreeView
trvList (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Maybe TreeIter
mIter <- ListStore a -> IO (Maybe TreeIter)
forall self. TreeModelClass self => self -> IO (Maybe TreeIter)
treeModelGetIterFirst ListStore a
store
  case Maybe TreeIter
mIter of
    Just iter :: TreeIter
iter -> TreeSelection -> TreeIter -> IO ()
forall self. TreeSelectionClass self => self -> TreeIter -> IO ()
treeSelectionSelectIter TreeSelection
selector TreeIter
iter
    Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Dialog -> StockId -> ResponseId -> IO Button
forall self string.
(DialogClass self, GlibString string) =>
self -> string -> ResponseId -> IO Button
dialogAddButton Dialog
dlg StockId
stockCancel ResponseId
ResponseCancel
  Dialog -> StockId -> ResponseId -> IO Button
forall self string.
(DialogClass self, GlibString string) =>
self -> string -> ResponseId -> IO Button
dialogAddButton Dialog
dlg StockId
stockOk ResponseId
ResponseOk

  ResponseId
rspns <- Dialog -> IO ResponseId
forall self. DialogClass self => self -> IO ResponseId
dialogRun Dialog
dlg
  Maybe (Int, a)
ret <- case ResponseId
rspns of
    ResponseCancel -> Maybe (Int, a) -> IO (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, a)
forall a. Maybe a
Nothing
    ResponseOk -> TreeView -> ListStore a -> IO (Maybe (Int, a))
forall a. TreeView -> ListStore a -> IO (Maybe (Int, a))
getSelectedSingle TreeView
trvList ListStore a
store
    _ -> Maybe (Int, a) -> IO (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, a)
forall a. Maybe a
Nothing
  Dialog -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetDestroy Dialog
dlg
  Maybe (Int, a) -> IO (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, a)
ret

-- | create a window with title and list of options, return selected option
listChoice :: String -- ^ Title
           -> [String] -- ^ Rows to display
           -> IO (Maybe Int) -- ^ Selected row
listChoice :: String -> [String] -> IO (Maybe Int)
listChoice title :: String
title items :: [String]
items = do
  Maybe (Int, String)
ret <- String
-> (String -> String) -> [String] -> IO (Maybe (Int, String))
forall a. String -> (a -> String) -> [a] -> IO (Maybe (Int, a))
listChoiceAux String
title String -> String
forall a. a -> a
id [String]
items
  Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> ((Int, String) -> Maybe Int) -> Maybe (Int, String) -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
forall a. Maybe a
Nothing (\ (i :: Int
i, _) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i) Maybe (Int, String)
ret

-- | create a window with title and list of options, return selected option
listChoiceExt :: String -- ^ Title
              -> [String] -- ^ Rows to display
              -> IO (Maybe Int) -- ^ Selected row
listChoiceExt :: String -> [String] -> IO (Maybe Int)
listChoiceExt title :: String
title = IO (Maybe Int) -> IO (Maybe Int)
forall a. IO a -> IO a
postGUISync (IO (Maybe Int) -> IO (Maybe Int))
-> ([String] -> IO (Maybe Int)) -> [String] -> IO (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> IO (Maybe Int)
listChoice String
title

-- | Progress/Pulse bar window
progressBarAux :: Bool -- ^ Percent or pulse
               -> String -- ^ Title
               -> String -- ^ Description
               -> IO (Double -> String -> IO (), IO ())
progressBarAux :: Bool -> String -> String -> IO (Double -> String -> IO (), IO ())
progressBarAux isProgress :: Bool
isProgress title :: String
title description :: String
description = do
  Builder
builder <- (String, String) -> IO Builder
getGTKBuilder (String, String)
Utils.get
  -- get window
  Window
window <- Builder -> (GObject -> Window) -> String -> IO Window
forall cls string.
(GObjectClass cls, GlibString string) =>
Builder -> (GObject -> cls) -> string -> IO cls
builderGetObject Builder
builder GObject -> Window
forall obj. GObjectClass obj => obj -> Window
castToWindow "ProgressBar"
  -- get progress bar
  ProgressBar
bar <- Builder -> (GObject -> ProgressBar) -> String -> IO ProgressBar
forall cls string.
(GObjectClass cls, GlibString string) =>
Builder -> (GObject -> cls) -> string -> IO cls
builderGetObject Builder
builder GObject -> ProgressBar
forall obj. GObjectClass obj => obj -> ProgressBar
castToProgressBar "pbProgress"

  Window -> String -> IO ()
forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetTitle Window
window String
title
  ProgressBar -> String -> IO ()
forall self string.
(ProgressBarClass self, GlibString string) =>
self -> string -> IO ()
progressBarSetText ProgressBar
bar String
description
  ProgressBar -> Double -> IO ()
forall self. ProgressBarClass self => self -> Double -> IO ()
progressBarSetPulseStep ProgressBar
bar 0.05
  Window -> WindowPosition -> IO ()
forall self. WindowClass self => self -> WindowPosition -> IO ()
windowSetPosition Window
window WindowPosition
WinPosCenter
  Window -> WindowTypeHint -> IO ()
forall self. WindowClass self => self -> WindowTypeHint -> IO ()
windowSetTypeHint Window
window WindowTypeHint
WindowTypeHintUtility

  IO ()
exit <- if Bool
isProgress then IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Window -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetDestroy Window
window) else do
    HandlerId
h <- IO Bool -> Int -> IO HandlerId
timeoutAdd (do
                      ProgressBar -> IO ()
forall self. ProgressBarClass self => self -> IO ()
progressBarPulse ProgressBar
bar
                      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                    ) 75
    IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (HandlerId -> IO ()
timeoutRemove HandlerId
h IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetDestroy Window
window)

  Window -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetShow Window
window

  let update :: Double -> string -> IO ()
update p :: Double
p d :: string
d = do
        ProgressBar -> string -> IO ()
forall self string.
(ProgressBarClass self, GlibString string) =>
self -> string -> IO ()
progressBarSetText ProgressBar
bar string
d
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isProgress (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgressBar -> Double -> IO ()
forall self. ProgressBarClass self => self -> Double -> IO ()
progressBarSetFraction ProgressBar
bar Double
p

  (Double -> String -> IO (), IO ())
-> IO (Double -> String -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> String -> IO ()
forall string. GlibString string => Double -> string -> IO ()
update, IO ()
exit)


progressBar :: String -- ^ Title
            -> String -- ^ Description
            -> IO (Double -> String -> IO (), IO ())
progressBar :: String -> String -> IO (Double -> String -> IO (), IO ())
progressBar = Bool -> String -> String -> IO (Double -> String -> IO (), IO ())
progressBarAux Bool
True

progressBarExt :: String -- ^ Title
               -> String -- ^ Description
               -> IO (Double -> String -> IO (), IO ())
progressBarExt :: String -> String -> IO (Double -> String -> IO (), IO ())
progressBarExt title :: String
title description :: String
description = do
  (update :: Double -> String -> IO ()
update, exit :: IO ()
exit) <- IO (Double -> String -> IO (), IO ())
-> IO (Double -> String -> IO (), IO ())
forall a. IO a -> IO a
postGUISync (IO (Double -> String -> IO (), IO ())
 -> IO (Double -> String -> IO (), IO ()))
-> IO (Double -> String -> IO (), IO ())
-> IO (Double -> String -> IO (), IO ())
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (Double -> String -> IO (), IO ())
progressBar String
title String
description
  (Double -> String -> IO (), IO ())
-> IO (Double -> String -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (\ a :: Double
a -> IO () -> IO ()
forall a. IO a -> IO a
postGUISync (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String -> IO ()
update Double
a, IO () -> IO ()
forall a. IO a -> IO a
postGUISync IO ()
exit)

pulseBar :: String -- ^ Title
         -> String -- ^ Description
         -> IO (String -> IO (), IO ())
pulseBar :: String -> String -> IO (String -> IO (), IO ())
pulseBar title :: String
title description :: String
description = do
  (update :: Double -> String -> IO ()
update, exit :: IO ()
exit) <- Bool -> String -> String -> IO (Double -> String -> IO (), IO ())
progressBarAux Bool
False String
title String
description
  let update' :: String -> IO ()
update' = Double -> String -> IO ()
update 0
  (String -> IO (), IO ()) -> IO (String -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO ()
update', IO ()
exit)

pulseBarExt :: String -- ^ Title
            -> String -- ^ Description
            -> IO (String -> IO (), IO ())
pulseBarExt :: String -> String -> IO (String -> IO (), IO ())
pulseBarExt title :: String
title description :: String
description = do
  (update :: String -> IO ()
update, exit :: IO ()
exit) <- IO (String -> IO (), IO ()) -> IO (String -> IO (), IO ())
forall a. IO a -> IO a
postGUISync (IO (String -> IO (), IO ()) -> IO (String -> IO (), IO ()))
-> IO (String -> IO (), IO ()) -> IO (String -> IO (), IO ())
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (String -> IO (), IO ())
pulseBar String
title String
description
  (String -> IO (), IO ()) -> IO (String -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO ()
forall a. IO a -> IO a
postGUISync (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
update, IO () -> IO ()
forall a. IO a -> IO a
postGUISync IO ()
exit)

-- | Display text in an uneditable, scrollable editor. Not blocking!
textView :: String -- ^ Title
         -> String -- ^ Message
         -> Maybe FilePath -- ^ Filename
         -> IO ()
textView :: String -> String -> Maybe String -> IO ()
textView title :: String
title message :: String
message mfile :: Maybe String
mfile = do
  Builder
builder <- (String, String) -> IO Builder
getGTKBuilder (String, String)
Utils.get
  -- get objects
  Dialog
dlg <- Builder -> (GObject -> Dialog) -> String -> IO Dialog
forall cls string.
(GObjectClass cls, GlibString string) =>
Builder -> (GObject -> cls) -> string -> IO cls
builderGetObject Builder
builder GObject -> Dialog
forall obj. GObjectClass obj => obj -> Dialog
castToDialog "TextView"
  TextView
tvText <- Builder -> (GObject -> TextView) -> String -> IO TextView
forall cls string.
(GObjectClass cls, GlibString string) =>
Builder -> (GObject -> cls) -> string -> IO cls
builderGetObject Builder
builder GObject -> TextView
forall obj. GObjectClass obj => obj -> TextView
castToTextView "tvText"

  Dialog -> String -> IO ()
forall self string.
(WindowClass self, GlibString string) =>
self -> string -> IO ()
windowSetTitle Dialog
dlg String
title
  TextBuffer
buffer <- TextView -> IO TextBuffer
forall self. TextViewClass self => self -> IO TextBuffer
textViewGetBuffer TextView
tvText
  TextBuffer -> String -> IO ()
forall self string.
(TextBufferClass self, GlibString string) =>
self -> string -> IO ()
textBufferInsertAtCursor TextBuffer
buffer String
message

  TextTagTable
tagTable <- TextBuffer -> IO TextTagTable
forall self. TextBufferClass self => self -> IO TextTagTable
textBufferGetTagTable TextBuffer
buffer
  TextTag
font <- Maybe StockId -> IO TextTag
textTagNew Maybe StockId
forall a. Maybe a
Nothing
  TextTag -> [AttrOp TextTag] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set TextTag
font [ Attr TextTag String
forall self string.
(TextTagClass self, GlibString string) =>
Attr self string
textTagFont Attr TextTag String -> String -> AttrOp TextTag
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= "FreeMono" ]
  TextTagTable -> TextTag -> IO ()
forall self tag.
(TextTagTableClass self, TextTagClass tag) =>
self -> tag -> IO ()
textTagTableAdd TextTagTable
tagTable TextTag
font
  TextIter
start <- TextBuffer -> IO TextIter
forall self. TextBufferClass self => self -> IO TextIter
textBufferGetStartIter TextBuffer
buffer
  TextIter
end <- TextBuffer -> IO TextIter
forall self. TextBufferClass self => self -> IO TextIter
textBufferGetEndIter TextBuffer
buffer
  TextBuffer -> TextTag -> TextIter -> TextIter -> IO ()
forall self tag.
(TextBufferClass self, TextTagClass tag) =>
self -> tag -> TextIter -> TextIter -> IO ()
textBufferApplyTag TextBuffer
buffer TextTag
font TextIter
start TextIter
end

  case Maybe String
mfile of
    Just file :: String
file -> do
      Button
btnSave <- Dialog -> StockId -> ResponseId -> IO Button
forall self string.
(DialogClass self, GlibString string) =>
self -> string -> ResponseId -> IO Button
dialogAddButton Dialog
dlg StockId
stockSave ResponseId
ResponseNone
      Button -> IO () -> IO (ConnectId Button)
forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked Button
btnSave (IO () -> IO (ConnectId Button)) -> IO () -> IO (ConnectId Button)
forall a b. (a -> b) -> a -> b
$ do
        FileChooserAction
-> String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileDialog FileChooserAction
FileChooserActionSave String
file
                   [("Nothing", ["*"]), ("Text", ["*.txt"])]
                   (Maybe (String -> IO ()) -> IO (Maybe String))
-> Maybe (String -> IO ()) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> IO ()) -> Maybe (String -> IO ())
forall a. a -> Maybe a
Just (String -> String -> IO ()
`writeFile` String
message)
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Button
btnClose <- Dialog -> StockId -> ResponseId -> IO Button
forall self string.
(DialogClass self, GlibString string) =>
self -> string -> ResponseId -> IO Button
dialogAddButton Dialog
dlg StockId
stockClose ResponseId
ResponseNone
  Button -> IO () -> IO (ConnectId Button)
forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked Button
btnClose (IO () -> IO (ConnectId Button)) -> IO () -> IO (ConnectId Button)
forall a b. (a -> b) -> a -> b
$ Dialog -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetDestroy Dialog
dlg

  Dialog -> IO ()
forall self. WidgetClass self => self -> IO ()
widgetShow Dialog
dlg
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Display text in an uneditable, scrollable editor. Not blocking!
textViewExt :: String -- ^ Title
         -> String -- ^ Message
         -> Maybe FilePath -- ^ Filename
         -> IO ()
textViewExt :: String -> String -> Maybe String -> IO ()
textViewExt title :: String
title message :: String
message = IO () -> IO ()
postGUIAsync (IO () -> IO ())
-> (Maybe String -> IO ()) -> Maybe String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String -> IO ()
textView String
title String
message

-- | displays a theory with warning in a window
displayTheoryWithWarning :: String -- ^ Kind of theory
                         -> String -- ^ Name of theory
                         -> String -- ^ Warning
                         -> G_theory -- ^ Theory
                         -> IO ()
displayTheoryWithWarning :: String -> String -> String -> G_theory -> IO ()
displayTheoryWithWarning k :: String
k n :: String
n w :: String
w t :: G_theory
t =
  String -> String -> Maybe String -> IO ()
textView (String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ " of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ G_theory -> String -> String
forall a. Pretty a => a -> String -> String
showDoc G_theory
t "\n") (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".dol"

-- | displays a theory with warning in a window
displayTheoryWithWarningExt :: String -- ^ Kind of theory
                            -> String -- ^ Name of theory
                            -> String -- ^ Warning
                            -> G_theory -- ^ Theory
                            -> IO ()
displayTheoryWithWarningExt :: String -> String -> String -> G_theory -> IO ()
displayTheoryWithWarningExt k :: String
k n :: String
n w :: String
w =
  IO () -> IO ()
postGUIAsync (IO () -> IO ()) -> (G_theory -> IO ()) -> G_theory -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> G_theory -> IO ()
displayTheoryWithWarning String
k String
n String
w

-- * Frequently used functions

-- | Setup list with single selection
setListSelectorSingle :: TreeView -> IO () -> IO (ConnectId TreeSelection)
setListSelectorSingle :: TreeView -> IO () -> IO (ConnectId TreeSelection)
setListSelectorSingle view :: TreeView
view action :: IO ()
action = do
  TreeSelection
selector <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view
  TreeSelection -> SelectionMode -> IO ()
forall self.
TreeSelectionClass self =>
self -> SelectionMode -> IO ()
treeSelectionSetMode TreeSelection
selector SelectionMode
SelectionSingle
  TreeSelection -> IO () -> IO (ConnectId TreeSelection)
forall self.
TreeSelectionClass self =>
self -> IO () -> IO (ConnectId self)
afterSelectionChanged TreeSelection
selector IO ()
action

-- | Setup list with multiple selection
setListSelectorMultiple :: TreeView -> Button -> Button -> Button -> IO ()
                        -> IO (ConnectId TreeSelection)
setListSelectorMultiple :: TreeView
-> Button
-> Button
-> Button
-> IO ()
-> IO (ConnectId TreeSelection)
setListSelectorMultiple view :: TreeView
view btnAll :: Button
btnAll btnNone :: Button
btnNone btnInvert :: Button
btnInvert action :: IO ()
action = do
  TreeSelection
selector <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view
  TreeSelection -> SelectionMode -> IO ()
forall self.
TreeSelectionClass self =>
self -> SelectionMode -> IO ()
treeSelectionSetMode TreeSelection
selector SelectionMode
SelectionMultiple
  ConnectId TreeSelection
sh <- TreeSelection -> IO () -> IO (ConnectId TreeSelection)
forall self.
TreeSelectionClass self =>
self -> IO () -> IO (ConnectId self)
afterSelectionChanged TreeSelection
selector IO ()
action

  -- setup buttons
  Button -> IO () -> IO (ConnectId Button)
forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked Button
btnAll (IO () -> IO (ConnectId Button)) -> IO () -> IO (ConnectId Button)
forall a b. (a -> b) -> a -> b
$ TreeView -> IO ()
selectAllRows TreeView
view
  Button -> IO () -> IO (ConnectId Button)
forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked Button
btnNone (IO () -> IO (ConnectId Button)) -> IO () -> IO (ConnectId Button)
forall a b. (a -> b) -> a -> b
$ TreeView -> IO ()
selectNoRows TreeView
view
  Button -> IO () -> IO (ConnectId Button)
forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked Button
btnInvert (TreeView -> ConnectId TreeSelection -> IO ()
selectInvert TreeView
view ConnectId TreeSelection
sh IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
action)
  ConnectId TreeSelection -> IO (ConnectId TreeSelection)
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectId TreeSelection
sh

-- | Selects the first item if possible
selectFirst :: TreeView -> IO ()
selectFirst :: TreeView -> IO ()
selectFirst view :: TreeView
view = do
  Maybe TreeModel
mModel <- TreeView -> IO (Maybe TreeModel)
forall self. TreeViewClass self => self -> IO (Maybe TreeModel)
treeViewGetModel TreeView
view
  case Maybe TreeModel
mModel of
    Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just model :: TreeModel
model -> do
      Maybe TreeIter
mIter <- TreeModel -> IO (Maybe TreeIter)
forall self. TreeModelClass self => self -> IO (Maybe TreeIter)
treeModelGetIterFirst TreeModel
model
      case Maybe TreeIter
mIter of
        Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just iter :: TreeIter
iter -> do
          TreeSelection
selector <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view
          TreeSelection -> TreeIter -> IO ()
forall self. TreeSelectionClass self => self -> TreeIter -> IO ()
treeSelectionSelectIter TreeSelection
selector TreeIter
iter

-- | Select all rows
selectAllRows :: TreeView -> IO ()
selectAllRows :: TreeView -> IO ()
selectAllRows view :: TreeView
view = TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view IO TreeSelection -> (TreeSelection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreeSelection -> IO ()
forall self. TreeSelectionClass self => self -> IO ()
treeSelectionSelectAll

-- | Deselect all rows
selectNoRows :: TreeView -> IO ()
selectNoRows :: TreeView -> IO ()
selectNoRows view :: TreeView
view = TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view IO TreeSelection -> (TreeSelection -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreeSelection -> IO ()
forall self. TreeSelectionClass self => self -> IO ()
treeSelectionUnselectAll

-- | Invert selection of list
selectInvert :: TreeView -> ConnectId TreeSelection -> IO ()
selectInvert :: TreeView -> ConnectId TreeSelection -> IO ()
selectInvert view :: TreeView
view handle :: ConnectId TreeSelection
handle = do
  ConnectId TreeSelection -> IO ()
forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalBlock ConnectId TreeSelection
handle
  TreeSelection
sel <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view
  [TreePath]
selected <- TreeSelection -> IO [TreePath]
forall self. TreeSelectionClass self => self -> IO [TreePath]
treeSelectionGetSelectedRows TreeSelection
sel
  TreeSelection -> IO ()
forall self. TreeSelectionClass self => self -> IO ()
treeSelectionSelectAll TreeSelection
sel
  [TreePath]
rows <- TreeSelection -> IO [TreePath]
forall self. TreeSelectionClass self => self -> IO [TreePath]
treeSelectionGetSelectedRows TreeSelection
sel
  (TreePath -> IO ()) -> [TreePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ row :: TreePath
row -> (if TreePath -> [TreePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem TreePath
row [TreePath]
selected
      then TreeSelection -> TreePath -> IO ()
forall self. TreeSelectionClass self => self -> TreePath -> IO ()
treeSelectionUnselectPath else TreeSelection -> TreePath -> IO ()
forall self. TreeSelectionClass self => self -> TreePath -> IO ()
treeSelectionSelectPath) TreeSelection
sel TreePath
row
    ) [TreePath]
rows
  ConnectId TreeSelection -> IO ()
forall obj. GObjectClass obj => ConnectId obj -> IO ()
signalUnblock ConnectId TreeSelection
handle

-- | Get selected item
getSelectedSingle :: TreeView -> ListStore a -> IO (Maybe (Int, a))
getSelectedSingle :: TreeView -> ListStore a -> IO (Maybe (Int, a))
getSelectedSingle view :: TreeView
view list :: ListStore a
list = do
  Maybe TreeModel
mModel <- TreeView -> IO (Maybe TreeModel)
forall self. TreeViewClass self => self -> IO (Maybe TreeModel)
treeViewGetModel TreeView
view
  case Maybe TreeModel
mModel of
    Nothing -> Maybe (Int, a) -> IO (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, a)
forall a. Maybe a
Nothing
    Just model :: TreeModel
model -> do
      TreeSelection
selector <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view
      Maybe TreeIter
mIter <- TreeSelection -> IO (Maybe TreeIter)
forall self. TreeSelectionClass self => self -> IO (Maybe TreeIter)
treeSelectionGetSelected TreeSelection
selector
      case Maybe TreeIter
mIter of
        Nothing -> Maybe (Int, a) -> IO (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, a)
forall a. Maybe a
Nothing
        Just iter :: TreeIter
iter -> do
          TreePath
path <- TreeModel -> TreeIter -> IO TreePath
forall self. TreeModelClass self => self -> TreeIter -> IO TreePath
treeModelGetPath TreeModel
model TreeIter
iter
          case TreePath
path of
            row :: Int
row : [] -> do
              a
item <- ListStore a -> Int -> IO a
forall a. ListStore a -> Int -> IO a
listStoreGetValue ListStore a
list Int
row
              Maybe (Int, a) -> IO (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, a) -> IO (Maybe (Int, a)))
-> Maybe (Int, a) -> IO (Maybe (Int, a))
forall a b. (a -> b) -> a -> b
$ (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
row, a
item)
            _ -> String -> IO (Maybe (Int, a))
forall a. HasCallStack => String -> a
error "List type not supported"

-- | Get selected items and row number
getSelectedMultiple :: TreeView -> ListStore a -> IO [(Int, a)]
getSelectedMultiple :: TreeView -> ListStore a -> IO [(Int, a)]
getSelectedMultiple view :: TreeView
view list :: ListStore a
list = do
  TreeSelection
selector <- TreeView -> IO TreeSelection
forall self. TreeViewClass self => self -> IO TreeSelection
treeViewGetSelection TreeView
view
  [TreePath]
rows' <- TreeSelection -> IO [TreePath]
forall self. TreeSelectionClass self => self -> IO [TreePath]
treeSelectionGetSelectedRows TreeSelection
selector
  let rows :: TreePath
rows = (TreePath -> Int) -> [TreePath] -> TreePath
forall a b. (a -> b) -> [a] -> [b]
map TreePath -> Int
forall a. [a] -> a
head [TreePath]
rows'
  [a]
items <- (Int -> IO a) -> TreePath -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ListStore a -> Int -> IO a
forall a. ListStore a -> Int -> IO a
listStoreGetValue ListStore a
list) TreePath
rows
  [(Int, a)] -> IO [(Int, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, a)] -> IO [(Int, a)]) -> [(Int, a)] -> IO [(Int, a)]
forall a b. (a -> b) -> a -> b
$ TreePath -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip TreePath
rows [a]
items

-- | Sets data of list
setListData :: TreeView -> (a -> String) -> [a] -> IO (ListStore a)
setListData :: TreeView -> (a -> String) -> [a] -> IO (ListStore a)
setListData view :: TreeView
view getT :: a -> String
getT listData :: [a]
listData = do
  ListStore a
store <- [a] -> IO (ListStore a)
forall a. [a] -> IO (ListStore a)
listStoreNew [a]
listData
  TreeView -> Maybe (ListStore a) -> IO ()
forall self model.
(TreeViewClass self, TreeModelClass model) =>
self -> Maybe model -> IO ()
treeViewSetModel TreeView
view (ListStore a -> Maybe (ListStore a)
forall a. a -> Maybe a
Just ListStore a
store)
  TreeView -> Bool -> IO ()
forall self. TreeViewClass self => self -> Bool -> IO ()
treeViewSetHeadersVisible TreeView
view Bool
False
  CellRendererText
ren <- IO CellRendererText
cellRendererTextNew
  TreeViewColumn
col <- IO TreeViewColumn
treeViewColumnNew
  TreeViewColumn -> CellRendererText -> Bool -> IO ()
forall cell.
CellRendererClass cell =>
TreeViewColumn -> cell -> Bool -> IO ()
treeViewColumnPackStart TreeViewColumn
col CellRendererText
ren Bool
True
  TreeViewColumn
-> CellRendererText
-> ListStore a
-> (a -> [AttrOp CellRendererText])
-> IO ()
forall self cell (model :: * -> *) row.
(CellLayoutClass self, CellRendererClass cell,
 TreeModelClass (model row), TypedTreeModelClass model) =>
self -> cell -> model row -> (row -> [AttrOp cell]) -> IO ()
cellLayoutSetAttributes TreeViewColumn
col CellRendererText
ren ListStore a
store
                          ((a -> [AttrOp CellRendererText]) -> IO ())
-> (a -> [AttrOp CellRendererText]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ i :: a
i -> [ WriteAttr CellRendererText (Maybe String)
forall cr string.
(CellRendererTextClass cr, GlibString string) =>
WriteAttr cr (Maybe string)
cellTextMarkup WriteAttr CellRendererText (Maybe String)
-> Maybe String -> AttrOp CellRendererText
forall o a b. ReadWriteAttr o a b -> b -> AttrOp o
:= String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ a -> String
getT a
i ]
  TreeView -> TreeViewColumn -> IO Int
forall self. TreeViewClass self => self -> TreeViewColumn -> IO Int
treeViewAppendColumn TreeView
view TreeViewColumn
col
  ListStore a -> IO (ListStore a)
forall (m :: * -> *) a. Monad m => a -> m a
return ListStore a
store

-- | Updates data of list
updateListData :: ListStore a -> [a] -> IO ()
updateListData :: ListStore a -> [a] -> IO ()
updateListData list :: ListStore a
list listData :: [a]
listData = do
  ListStore a -> IO ()
forall a. ListStore a -> IO ()
listStoreClear ListStore a
list
  (a -> IO Int) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ListStore a -> a -> IO Int
forall a. ListStore a -> a -> IO Int
listStoreAppend ListStore a
list) [a]
listData

-- | Activates or deactivates a list of widgets
activate :: [Widget] -> Bool -> IO ()
activate :: [Widget] -> Bool -> IO ()
activate widgets :: [Widget]
widgets active :: Bool
active = (Widget -> IO ()) -> [Widget] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Widget -> Bool -> IO ()
forall self. WidgetClass self => self -> Bool -> IO ()
`widgetSetSensitive` Bool
active) [Widget]
widgets

toComboBoxText :: Show a => [a] -> [ComboBoxText]
#ifdef GTK12
toComboBoxText = map show

type ComboBoxText = String
#else
toComboBoxText :: [a] -> [StockId]
toComboBoxText = (a -> StockId) -> [a] -> [StockId]
forall a b. (a -> b) -> [a] -> [b]
map (String -> StockId
Text.pack (String -> StockId) -> (a -> String) -> a -> StockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
#endif