GTK: add IconView and refactor the modules

2015-12-30 17:53:16 +01:00
parent 2bc406f65e
commit b266b78e14
9 changed files with 706 additions and 618 deletions
--- a/src/GUI/Gtk/Callbacks.hs
+++ b/src/GUI/Gtk/Callbacks.hs
@@ -28,9 +28,7 @@ import Control.Applicative
  )
 import Control.Concurrent.STM
  (
-    TVar
-  , newTVarIO
-  , readTVarIO
+    readTVarIO
  )
 import Control.Exception
  (
@@ -53,6 +51,7 @@ import Data.Foldable
 import Graphics.UI.Gtk
 import GUI.Gtk.Data
 import GUI.Gtk.Dialogs
+import GUI.Gtk.MyView
 import GUI.Gtk.Utils
 import IO.Error
 import IO.File
@@ -77,109 +76,121 @@ import System.Glib.UTFString


 -- |Set callbacks, on hotkeys, events and stuff.
--
-- Interaction with mutable references:
--
-- * 'settings mygui' modifies
 setCallbacks :: MyGUI -> MyView -> IO ()
 setCallbacks mygui myview = do
-  -- GUI events
-  _ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
-  _ <- treeView mygui `on` rowActivated $ (\_ _ -> withRows mygui myview open)
-  _ <- refreshView mygui `on` buttonActivated $ do
-       cdir <- liftIO $ getCurrentDir myview
-       refreshTreeView' mygui myview cdir
-  _ <- clearStatusBar mygui `on` buttonActivated $ do
-       popStatusbar mygui
-       writeTVarIO (operationBuffer myview) None
+  view' <- readTVarIO $ view myview
+  case view' of
+    FMTreeView treeView -> setTreeViewCallbacks treeView
+    FMIconView iconView -> return ()
+  menubarCallbacks
+  where
+    menubarCallbacks = do
+      -- menubar-file
+      _ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit
+      _ <- menubarFileOpen mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview open
+      _ <- menubarFileExecute mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview execute
+      _ <- menubarFileNew mygui `on` menuItemActivated $
+        liftIO $ newFile mygui myview

-  -- key events
-  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
-    "q"       <- fmap glibToString eventKeyName
-    liftIO mainQuit
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
-    "h"       <- fmap glibToString eventKeyName
-    cdir <- liftIO $ getCurrentDir myview
-    liftIO $ modifyTVarIO (settings mygui)
-                          (\x -> x { showHidden = not . showHidden $ x})
-             >> refreshTreeView' mygui myview cdir
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    [Alt] <- eventModifier
-    "Up"  <- fmap glibToString eventKeyName
-    liftIO $ upDir mygui myview
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    "Delete"  <- fmap glibToString eventKeyName
-    liftIO $ withRows mygui myview del
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    []            <- eventModifier
-    "Return"      <- fmap glibToString eventKeyName
-    liftIO $ withRows mygui myview open
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
-    "c"       <- fmap glibToString eventKeyName
-    liftIO $ withRows mygui myview copyInit
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
-    "x"       <- fmap glibToString eventKeyName
-    liftIO $ withRows mygui myview moveInit
-  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
-    [Control] <- eventModifier
-    "v"       <- fmap glibToString eventKeyName
-    liftIO $ operationFinal mygui myview
+      -- menubar-edit
+      _ <- menubarEditCut mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview moveInit
+      _ <- menubarEditCopy mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview copyInit
+      _ <- menubarEditRename mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview renameF
+      _ <- menubarEditPaste mygui `on` menuItemActivated $
+        liftIO $ operationFinal mygui myview
+      _ <- menubarEditDelete mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview del

-  -- menubar-file
-  _ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit
-  _ <- menubarFileOpen mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview open
-  _ <- menubarFileExecute mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview execute
-  _ <- menubarFileNew mygui `on` menuItemActivated $
-    liftIO $ newFile mygui myview
+      -- mewnubar-view
+      _ <- menubarViewIcon mygui `on` menuItemActivated $
+        liftIO $ switchView mygui myview createIconView
+      _ <- menubarViewTree mygui `on` menuItemActivated $
+        liftIO $ switchView mygui myview createTreeView

-  -- menubar-edit
-  _ <- menubarEditCut mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview moveInit
-  _ <- menubarEditCopy mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview copyInit
-  _ <- menubarEditRename mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview renameF
-  _ <- menubarEditPaste mygui `on` menuItemActivated $
-    liftIO $ operationFinal mygui myview
-  _ <- menubarEditDelete mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview del
+      -- menubar-help
+      _ <- menubarHelpAbout mygui `on` menuItemActivated $
+        liftIO showAboutDialog
+      return ()
+    setTreeViewCallbacks treeView = do
+      -- GUI events
+      _ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
+      _ <- treeView `on` rowActivated
+             $ (\_ _ -> withItems mygui myview open)
+      _ <- refreshViewB mygui `on` buttonActivated $ do
+           cdir <- liftIO $ getCurrentDir myview
+           refreshView' mygui myview cdir
+      _ <- clearStatusBar mygui `on` buttonActivated $ do
+           popStatusbar mygui
+           writeTVarIO (operationBuffer myview) None

-  -- menubar-help
-  _ <- menubarHelpAbout mygui `on` menuItemActivated $
-    liftIO showAboutDialog
+      -- key events
+      _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
+        [Control] <- eventModifier
+        "q"       <- fmap glibToString eventKeyName
+        liftIO mainQuit
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        [Control] <- eventModifier
+        "h"       <- fmap glibToString eventKeyName
+        cdir <- liftIO $ getCurrentDir myview
+        liftIO $ modifyTVarIO (settings mygui)
+                              (\x -> x { showHidden = not . showHidden $ x})
+                 >> refreshView' mygui myview cdir
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        [Alt] <- eventModifier
+        "Up"  <- fmap glibToString eventKeyName
+        liftIO $ upDir mygui myview
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        "Delete"  <- fmap glibToString eventKeyName
+        liftIO $ withItems mygui myview del
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        []            <- eventModifier
+        "Return"      <- fmap glibToString eventKeyName
+        liftIO $ withItems mygui myview open
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        [Control] <- eventModifier
+        "c"       <- fmap glibToString eventKeyName
+        liftIO $ withItems mygui myview copyInit
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        [Control] <- eventModifier
+        "x"       <- fmap glibToString eventKeyName
+        liftIO $ withItems mygui myview moveInit
+      _ <- treeView `on` keyPressEvent $ tryEvent $ do
+        [Control] <- eventModifier
+        "v"       <- fmap glibToString eventKeyName
+        liftIO $ operationFinal mygui myview

-  -- righ-click
-  _ <- treeView mygui `on` buttonPressEvent $ do
-    eb <- eventButton
-    t  <- eventTime
-    case eb of
-      RightButton -> liftIO $ menuPopup (rcMenu mygui) $ Just (RightButton, t)
-      _           -> return ()
-    return False
-  _ <- rcFileOpen mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview open
-  _ <- rcFileExecute mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview execute
-  _ <- rcFileNew mygui `on` menuItemActivated $
-    liftIO $ newFile mygui myview
-  _ <- rcFileCopy mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview copyInit
-  _ <- rcFileRename mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview renameF
-  _ <- rcFilePaste mygui `on` menuItemActivated $
-    liftIO $ operationFinal mygui myview
-  _ <- rcFileDelete mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview del
-  _ <- rcFileCut mygui `on` menuItemActivated $
-    liftIO $ withRows mygui myview moveInit
+      -- righ-click
+      _ <- treeView `on` buttonPressEvent $ do
+        eb <- eventButton
+        t  <- eventTime
+        case eb of
+          RightButton -> liftIO $ menuPopup (rcMenu mygui)
+            $ Just (RightButton, t)
+          _           -> return ()
+        return False
+      _ <- rcFileOpen mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview open
+      _ <- rcFileExecute mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview execute
+      _ <- rcFileNew mygui `on` menuItemActivated $
+        liftIO $ newFile mygui myview
+      _ <- rcFileCopy mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview copyInit
+      _ <- rcFileRename mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview renameF
+      _ <- rcFilePaste mygui `on` menuItemActivated $
+        liftIO $ operationFinal mygui myview
+      _ <- rcFileDelete mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview del
+      _ <- rcFileCut mygui `on` menuItemActivated $
+        liftIO $ withItems mygui myview moveInit

-  return ()
+      return ()


 -- |Go to the url given at the 'urlBar' and visualize it in the given
@@ -190,16 +201,16 @@ urlGoTo mygui myview = withErrorDialog $ do
  let abs = isAbsolute fp
  exists <- (||) <$> doesDirectoryExist fp <*> doesFileExist fp
  -- TODO: more explicit error handling?
-  refreshTreeView mygui myview (Just fp)
+  refreshView mygui myview (Just fp)


 -- |Supposed to be used with 'withRows'. Opens a file or directory.
-open :: [Row] -> MyGUI -> MyView -> IO ()
-open [row] mygui myview = withErrorDialog $
-  case row of
+open :: [Item] -> MyGUI -> MyView -> IO ()
+open [item] mygui myview = withErrorDialog $
+  case item of
    ADirOrSym r -> do
      nv <- Data.DirTree.readFile $ fullPath r
-      refreshTreeView' mygui myview nv
+      refreshView' mygui myview nv
    r ->
      void $ openFile r
 -- this throws on the first error that occurs
@@ -211,39 +222,35 @@ open _ _ _ = withErrorDialog


 -- |Execute a given file.
-execute :: [Row] -> MyGUI -> MyView -> IO ()
-execute [row] mygui myview = withErrorDialog $
-  void $ executeFile row []
+execute :: [Item] -> MyGUI -> MyView -> IO ()
+execute [item] mygui myview = withErrorDialog $
+  void $ executeFile item []
 execute _ _ _ = withErrorDialog
                  . throw $ InvalidOperation
                            "Operation not supported on multiple files"


 -- |Supposed to be used with 'withRows'. Deletes a file or directory.
-del :: [Row] -> MyGUI -> MyView -> IO ()
-del [row] mygui myview = withErrorDialog $ do
-  let cmsg  = "Really delete \"" ++ fullPath row ++ "\"?"
+del :: [Item] -> MyGUI -> MyView -> IO ()
+del [item] mygui myview = withErrorDialog $ do
+  let cmsg  = "Really delete \"" ++ fullPath item ++ "\"?"
  withConfirmationDialog cmsg
-    $ easyDelete row
+    $ easyDelete item
 -- this throws on the first error that occurs
-del rows@(_:_) mygui myview = withErrorDialog $ do
-  let cmsg  = "Really delete " ++ show (length rows) ++ " files?"
+del items@(_:_) mygui myview = withErrorDialog $ do
+  let cmsg  = "Really delete " ++ show (length items) ++ " files?"
  withConfirmationDialog cmsg
-    $ forM_ rows $ \row -> easyDelete row
+    $ forM_ items $ \item -> easyDelete item
 del _ _ _ = withErrorDialog
              . throw $ InvalidOperation
                        "Operation not supported on multiple files"


 -- |Initializes a file move operation.
--
-- Interaction with mutable references:
--
-- * 'operationBuffer' writes
-moveInit :: [Row] -> MyGUI -> MyView -> IO ()
-moveInit [row] mygui myview = do
-  writeTVarIO (operationBuffer myview) (FMove . MP1 $ row)
-  let sbmsg = "Move buffer: " ++ fullPath row
+moveInit :: [Item] -> MyGUI -> MyView -> IO ()
+moveInit [item] mygui myview = do
+  writeTVarIO (operationBuffer myview) (FMove . MP1 $ item)
+  let sbmsg = "Move buffer: " ++ fullPath item
  popStatusbar mygui
  void $ pushStatusBar mygui sbmsg
 moveInit _ _ _ = withErrorDialog
@@ -251,14 +258,10 @@ moveInit _ _ _ = withErrorDialog
                             "Operation not supported on multiple files"

 -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
--
-- Interaction with mutable references:
--
-- * 'operationBuffer' writes
-copyInit :: [Row] -> MyGUI -> MyView -> IO ()
-copyInit [row] mygui myview = do
-  writeTVarIO (operationBuffer myview) (FCopy . CP1 $ row)
-  let sbmsg = "Copy buffer: " ++ fullPath row
+copyInit :: [Item] -> MyGUI -> MyView -> IO ()
+copyInit [item] mygui myview = do
+  writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item)
+  let sbmsg = "Copy buffer: " ++ fullPath item
  popStatusbar mygui
  void $ pushStatusBar mygui sbmsg
 copyInit _ _ _ = withErrorDialog
@@ -267,10 +270,6 @@ copyInit _ _ _ = withErrorDialog


 -- |Finalizes a file operation, such as copy or move.
--
-- Interaction with mutable references:
--
-- * 'operationBuffer' reads
 operationFinal :: MyGUI -> MyView -> IO ()
 operationFinal mygui myview = withErrorDialog $ do
  op <- readTVarIO (operationBuffer myview)
@@ -292,18 +291,13 @@ operationFinal mygui myview = withErrorDialog $ do


 -- |Go up one directory and visualize it in the treeView.
--
-- Interaction with mutable references:
--
-- * 'rawModel' reads
-- * 'sortedModel' reads
 upDir :: MyGUI -> MyView -> IO ()
 upDir mygui myview = withErrorDialog $ do
  cdir <- getCurrentDir myview
  rawModel'    <- readTVarIO $ rawModel myview
  sortedModel' <- readTVarIO $ sortedModel myview
  nv <- goUp cdir
-  refreshTreeView' mygui myview nv
+  refreshView' mygui myview nv


 -- |Go up one directory and visualize it in the treeView.
@@ -315,13 +309,13 @@ newFile mygui myview = withErrorDialog $ do
    createFile cdir fn


-renameF :: [Row] -> MyGUI -> MyView -> IO ()
-renameF [row] mygui myview = withErrorDialog $ do
+renameF :: [Item] -> MyGUI -> MyView -> IO ()
+renameF [item] mygui myview = withErrorDialog $ do
  mfn   <- textInputDialog "Enter new file name"
  for_ mfn $ \fn -> do
-    let cmsg = "Really rename \"" ++ fullPath row
-               ++ "\"" ++ " to \"" ++ anchor row </> fn ++ "\"?"
-    withConfirmationDialog cmsg $ IO.File.renameFile row fn
+    let cmsg = "Really rename \"" ++ fullPath item
+               ++ "\"" ++ " to \"" ++ anchor item </> fn ++ "\"?"
+    withConfirmationDialog cmsg $ IO.File.renameFile item fn
 renameF _ _ _ = withErrorDialog
                  . throw $ InvalidOperation
                            "Operation not supported on multiple files"