From 06b96eecea0d859df3faa3a3459b1ee8f26d4632 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Wed, 23 Dec 2015 16:14:38 +0100 Subject: [PATCH] GTK: restructure modules a bit --- hsfm.cabal | 1 - src/GUI/Gtk.hs | 214 +++++++++++++++++++++++++++++++++++++++++- src/GUI/Gtk/Gui.hs | 226 --------------------------------------------- 3 files changed, 212 insertions(+), 229 deletions(-) delete mode 100644 src/GUI/Gtk/Gui.hs diff --git a/hsfm.cabal b/hsfm.cabal index 2bd266a..67a4044 100644 --- a/hsfm.cabal +++ b/hsfm.cabal @@ -52,7 +52,6 @@ executable hsfm-gtk other-modules: GUI.Gtk.Callbacks GUI.Gtk.Data GUI.Gtk.Dialogs - GUI.Gtk.Gui GUI.Gtk.Icons GUI.Gtk.Utils MyPrelude diff --git a/src/GUI/Gtk.hs b/src/GUI/Gtk.hs index 552bbb4..5833184 100644 --- a/src/GUI/Gtk.hs +++ b/src/GUI/Gtk.hs @@ -2,16 +2,102 @@ module Main where +import Control.Applicative + ( + (<$>) + , (<*>) + ) +import Control.Concurrent + ( + forkIO + ) +import Control.Concurrent.STM + ( + TVar + , newTVarIO + , readTVarIO + ) +import Control.Exception + ( + try + , Exception + , SomeException + ) +import Control.Monad + ( + when + , void + ) +import Control.Monad.IO.Class + ( + liftIO + ) +import Data.DirTree +import Data.Foldable + ( + for_ + ) +import Data.List + ( + sort + , isPrefixOf + ) +import Data.Maybe + ( + fromJust + , catMaybes + , fromMaybe + ) +import Data.Traversable + ( + forM + ) import Graphics.UI.Gtk -import GUI.Gtk.Gui +import GUI.Gtk.Callbacks +import GUI.Gtk.Data +import GUI.Gtk.Dialogs +import GUI.Gtk.Icons +import GUI.Gtk.Utils +import IO.Error +import IO.File +import IO.Utils +import MyPrelude import Safe ( headDef ) +import System.Directory + ( + executable + , doesFileExist + , doesDirectoryExist + ) import System.Environment ( getArgs ) +import System.FilePath + ( + isAbsolute + , () + ) +import System.Glib.UTFString + ( + glibToString + ) +import System.IO.Unsafe + ( + unsafePerformIO + ) +import System.Process + ( + spawnProcess + ) + + +-- TODO: simplify where we modify the TVars +-- TODO: double check garbage collection/gtk ref counting +-- TODO: file watching, when and what to reread main :: IO () @@ -22,4 +108,128 @@ main = do startMainWindow (headDef "/" args) - mainGUI + _ <- mainGUI + return () + + + ------------------------- + --[ Main Window Setup ]-- + ------------------------- + + +-- |Set up the GUI. +-- +-- Interaction with mutable references: +-- +-- * 'settings' creates +-- * 'operationBuffer' creates +-- * 'rawModel' creates +-- * 'filteredModel' creates +-- * 'sortedModel' creates +startMainWindow :: FilePath -> IO () +startMainWindow startdir = do + + settings <- newTVarIO (MkFMSettings False True) + + -- get the icons + iT <- iconThemeGetDefault + folderPix <- getIcon IFolder 24 + filePix <- getIcon IFile 24 + errorPix <- getIcon IError 24 + + operationBuffer <- newTVarIO None + + builder <- builderNew + builderAddFromFile builder "data/Gtk/builder.xml" + + -- get the pre-defined gui widgets + rootWin <- builderGetObject builder castToWindow + "rootWin" + scroll <- builderGetObject builder castToScrolledWindow + "mainScroll" + menubarFileQuit <- builderGetObject builder castToImageMenuItem + "menubarFileQuit" + menubarFileOpen <- builderGetObject builder castToImageMenuItem + "menubarFileOpen" + menubarFileCut <- builderGetObject builder castToImageMenuItem + "menubarFileCut" + menubarFileCopy <- builderGetObject builder castToImageMenuItem + "menubarFileCopy" + menubarFilePaste <- builderGetObject builder castToImageMenuItem + "menubarFilePaste" + menubarFileDelete <- builderGetObject builder castToImageMenuItem + "menubarFileDelete" + menubarHelpAbout <- builderGetObject builder castToImageMenuItem + "menubarHelpAbout" + urlBar <- builderGetObject builder castToEntry + "urlBar" + statusBar <- builderGetObject builder castToStatusbar + "statusBar" + + -- create initial list store model with unsorted data + rawModel <- newTVarIO =<< listStoreNew + =<< Data.DirTree.getContents + =<< Data.DirTree.readFile startdir + + filteredModel <- newTVarIO =<< (\x -> treeModelFilterNew x []) + =<< readTVarIO rawModel + + -- create an initial sorting proxy model + sortedModel <- newTVarIO =<< treeModelSortNewWithModel + =<< readTVarIO filteredModel + + -- create the final view + treeView <- treeViewNew + + -- create final tree model columns + renderTxt <- cellRendererTextNew + renderPix <- cellRendererPixbufNew + let ct = cellText :: (CellRendererTextClass cr) => Attr cr String + cp = cellPixbuf :: (CellRendererPixbufClass self) => Attr self Pixbuf + + -- filename column + cF <- treeViewColumnNew + treeViewColumnSetTitle cF "Filename" + treeViewColumnSetResizable cF True + treeViewColumnSetClickable cF True + treeViewColumnSetSortColumnId cF 1 + cellLayoutPackStart cF renderPix False + cellLayoutPackStart cF renderTxt True + _ <- treeViewAppendColumn treeView cF + cellLayoutAddColumnAttribute cF renderPix cp $ makeColumnIdPixbuf 0 + cellLayoutAddColumnAttribute cF renderTxt ct $ makeColumnIdString 1 + + -- date column + cMD <- treeViewColumnNew + treeViewColumnSetTitle cMD "Date" + treeViewColumnSetResizable cMD True + treeViewColumnSetClickable cMD True + treeViewColumnSetSortColumnId cMD 2 + cellLayoutPackStart cMD renderTxt True + _ <- treeViewAppendColumn treeView cMD + cellLayoutAddColumnAttribute cMD renderTxt ct $ makeColumnIdString 2 + + -- permissions column + cP <- treeViewColumnNew + treeViewColumnSetTitle cP "Permission" + treeViewColumnSetResizable cP True + treeViewColumnSetClickable cP True + treeViewColumnSetSortColumnId cP 3 + cellLayoutPackStart cP renderTxt True + _ <- treeViewAppendColumn treeView cP + cellLayoutAddColumnAttribute cP renderTxt ct $ makeColumnIdString 3 + + -- construct the gui object + let mygui = MkMyGUI {..} + let myview = MkMyView {..} + + -- create the tree model with its contents + constructTreeView mygui myview + + -- set the bindings + setCallbacks mygui myview + + -- add the treeview to the scroll container + containerAdd scroll treeView + + widgetShowAll rootWin diff --git a/src/GUI/Gtk/Gui.hs b/src/GUI/Gtk/Gui.hs deleted file mode 100644 index f4a791d..0000000 --- a/src/GUI/Gtk/Gui.hs +++ /dev/null @@ -1,226 +0,0 @@ -{-# OPTIONS_HADDOCK ignore-exports #-} - --- |The main Gtk Gui module for creating the main window. -module GUI.Gtk.Gui (startMainWindow) where - - -import Control.Applicative - ( - (<$>) - , (<*>) - ) -import Control.Concurrent - ( - forkIO - ) -import Control.Concurrent.STM - ( - TVar - , newTVarIO - , readTVarIO - ) -import Control.Exception - ( - try - , Exception - , SomeException - ) -import Control.Monad - ( - when - , void - ) -import Control.Monad.IO.Class - ( - liftIO - ) -import Data.DirTree -import Data.Foldable - ( - for_ - ) -import Data.List - ( - sort - , isPrefixOf - ) -import Data.Maybe - ( - fromJust - , catMaybes - , fromMaybe - ) -import Data.Traversable - ( - forM - ) -import Graphics.UI.Gtk -import GUI.Gtk.Callbacks -import GUI.Gtk.Data -import GUI.Gtk.Dialogs -import GUI.Gtk.Icons -import GUI.Gtk.Utils -import IO.Error -import IO.File -import IO.Utils -import MyPrelude -import System.Directory - ( - executable - , doesFileExist - , doesDirectoryExist - ) -import System.Environment - ( - getArgs - ) -import System.FilePath - ( - isAbsolute - , () - ) -import System.Glib.UTFString - ( - glibToString - ) -import System.IO.Unsafe - ( - unsafePerformIO - ) -import System.Process - ( - spawnProcess - ) - - - - --- TODO: simplify where we modify the TVars --- TODO: double check garbage collection/gtk ref counting --- TODO: file watching, when and what to reread - - - - - - ------------------------- - --[ Main Window Setup ]-- - ------------------------- - - --- |Set up the GUI. --- --- Interaction with mutable references: --- --- * 'settings' creates --- * 'operationBuffer' creates --- * 'rawModel' creates --- * 'filteredModel' creates --- * 'sortedModel' creates -startMainWindow :: FilePath -> IO () -startMainWindow startdir = do - - settings <- newTVarIO (MkFMSettings False True) - - -- get the icons - iT <- iconThemeGetDefault - folderPix <- getIcon IFolder 24 - filePix <- getIcon IFile 24 - errorPix <- getIcon IError 24 - - operationBuffer <- newTVarIO None - - builder <- builderNew - builderAddFromFile builder "data/Gtk/builder.xml" - - -- get the pre-defined gui widgets - rootWin <- builderGetObject builder castToWindow - "rootWin" - scroll <- builderGetObject builder castToScrolledWindow - "mainScroll" - menubarFileQuit <- builderGetObject builder castToImageMenuItem - "menubarFileQuit" - menubarFileOpen <- builderGetObject builder castToImageMenuItem - "menubarFileOpen" - menubarFileCut <- builderGetObject builder castToImageMenuItem - "menubarFileCut" - menubarFileCopy <- builderGetObject builder castToImageMenuItem - "menubarFileCopy" - menubarFilePaste <- builderGetObject builder castToImageMenuItem - "menubarFilePaste" - menubarFileDelete <- builderGetObject builder castToImageMenuItem - "menubarFileDelete" - menubarHelpAbout <- builderGetObject builder castToImageMenuItem - "menubarHelpAbout" - urlBar <- builderGetObject builder castToEntry - "urlBar" - statusBar <- builderGetObject builder castToStatusbar - "statusBar" - - -- create initial list store model with unsorted data - rawModel <- newTVarIO =<< listStoreNew - =<< Data.DirTree.getContents - =<< Data.DirTree.readFile startdir - - filteredModel <- newTVarIO =<< (\x -> treeModelFilterNew x []) - =<< readTVarIO rawModel - - -- create an initial sorting proxy model - sortedModel <- newTVarIO =<< treeModelSortNewWithModel - =<< readTVarIO filteredModel - - -- create the final view - treeView <- treeViewNew - - -- create final tree model columns - renderTxt <- cellRendererTextNew - renderPix <- cellRendererPixbufNew - let ct = cellText :: (CellRendererTextClass cr) => Attr cr String - cp = cellPixbuf :: (CellRendererPixbufClass self) => Attr self Pixbuf - - -- filename column - cF <- treeViewColumnNew - treeViewColumnSetTitle cF "Filename" - treeViewColumnSetResizable cF True - treeViewColumnSetClickable cF True - treeViewColumnSetSortColumnId cF 1 - cellLayoutPackStart cF renderPix False - cellLayoutPackStart cF renderTxt True - _ <- treeViewAppendColumn treeView cF - cellLayoutAddColumnAttribute cF renderPix cp $ makeColumnIdPixbuf 0 - cellLayoutAddColumnAttribute cF renderTxt ct $ makeColumnIdString 1 - - -- date column - cMD <- treeViewColumnNew - treeViewColumnSetTitle cMD "Date" - treeViewColumnSetResizable cMD True - treeViewColumnSetClickable cMD True - treeViewColumnSetSortColumnId cMD 2 - cellLayoutPackStart cMD renderTxt True - _ <- treeViewAppendColumn treeView cMD - cellLayoutAddColumnAttribute cMD renderTxt ct $ makeColumnIdString 2 - - -- permissions column - cP <- treeViewColumnNew - treeViewColumnSetTitle cP "Permission" - treeViewColumnSetResizable cP True - treeViewColumnSetClickable cP True - treeViewColumnSetSortColumnId cP 3 - cellLayoutPackStart cP renderTxt True - _ <- treeViewAppendColumn treeView cP - cellLayoutAddColumnAttribute cP renderTxt ct $ makeColumnIdString 3 - - -- construct the gui object - let mygui = MkMyGUI {..} - let myview = MkMyView {..} - - -- create the tree model with its contents - constructTreeView mygui myview - - -- set the bindings - setCallbacks mygui myview - - -- add the treeview to the scroll container - containerAdd scroll treeView - - widgetShowAll rootWin