LIB/GTK: add move menuitem and implement creating new files

data/Gtk/builder.xml

@@ -2,6 +2,11 @@
 <!-- Generated with glade 3.19.0 -->
 <interface>
   <requires lib="gtk+" version="3.16"/>
+  <object class="GtkImage" id="image1">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="stock">gtk-edit</property>
+  </object>
   <object class="GtkMenu" id="rcMenu">
     <property name="visible">True</property>
     <property name="can_focus">False</property>
@@ -23,6 +28,15 @@
         <property name="use_stock">True</property>
       </object>
     </child>
+    <child>
+      <object class="GtkImageMenuItem" id="rcFileNew">
+        <property name="label">gtk-new</property>
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="use_underline">True</property>
+        <property name="use_stock">True</property>
+      </object>
+    </child>
     <child>
       <object class="GtkSeparatorMenuItem" id="separatormenuitem2">
         <property name="visible">True</property>
@@ -47,6 +61,15 @@
         <property name="use_stock">True</property>
       </object>
     </child>
+    <child>
+      <object class="GtkImageMenuItem" id="rcFileMove">
+        <property name="label">Move</property>
+        <property name="visible">True</property>
+        <property name="can_focus">False</property>
+        <property name="image">image1</property>
+        <property name="use_stock">False</property>
+      </object>
+    </child>
     <child>
       <object class="GtkImageMenuItem" id="rcFilePaste">
         <property name="label">gtk-paste</property>
@@ -66,6 +89,11 @@
       </object>
     </child>
   </object>
+  <object class="GtkImage" id="image2">
+    <property name="visible">True</property>
+    <property name="can_focus">False</property>
+    <property name="stock">gtk-edit</property>
+  </object>
   <object class="GtkApplicationWindow" id="rootWin">
     <property name="can_focus">False</property>
     <child>
@@ -105,6 +133,15 @@
                         <property name="use_stock">True</property>
                       </object>
                     </child>
+                    <child>
+                      <object class="GtkImageMenuItem" id="menubarFileNew">
+                        <property name="label">gtk-new</property>
+                        <property name="visible">True</property>
+                        <property name="can_focus">False</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </object>
+                    </child>
                     <child>
                       <object class="GtkSeparatorMenuItem" id="separatormenuitem1">
                         <property name="visible">True</property>
@@ -152,6 +189,15 @@
                         <property name="use_stock">True</property>
                       </object>
                     </child>
+                    <child>
+                      <object class="GtkImageMenuItem" id="menubarEditMove">
+                        <property name="label">Move</property>
+                        <property name="visible">True</property>
+                        <property name="can_focus">False</property>
+                        <property name="image">image2</property>
+                        <property name="use_stock">False</property>
+                      </object>
+                    </child>
                     <child>
                       <object class="GtkImageMenuItem" id="menubarEditPaste">
                         <property name="label">gtk-paste</property>

src/GUI/Gtk.hs

@@ -171,10 +171,14 @@ startMainWindow startdir = do
                        "menubarFileOpen"
   menubarFileExecute <- builderGetObject builder castToImageMenuItem
                         "menubarFileExecute"
+  menubarFileNew    <- builderGetObject builder castToImageMenuItem
+                       "menubarFileNew"
   menubarEditCut    <- builderGetObject builder castToImageMenuItem
                        "menubarEditCut"
   menubarEditCopy   <- builderGetObject builder castToImageMenuItem
                        "menubarEditCopy"
+  menubarEditMove   <- builderGetObject builder castToImageMenuItem
+                       "menubarEditMove"
   menubarEditPaste  <- builderGetObject builder castToImageMenuItem
                        "menubarEditPaste"
   menubarEditDelete <- builderGetObject builder castToImageMenuItem
@@ -191,10 +195,14 @@ startMainWindow startdir = do
                        "rcFileOpen"
   rcFileExecute     <- builderGetObject builder castToImageMenuItem
                        "rcFileExecute"
+  rcFileNew         <- builderGetObject builder castToImageMenuItem
+                       "rcFileNew"
   rcFileCut         <- builderGetObject builder castToImageMenuItem
                        "rcFileCut"
   rcFileCopy        <- builderGetObject builder castToImageMenuItem
                        "rcFileCopy"
+  rcFileMove        <- builderGetObject builder castToImageMenuItem
+                       "rcFileMove"
   rcFilePaste       <- builderGetObject builder castToImageMenuItem
                        "rcFilePaste"
   rcFileDelete      <- builderGetObject builder castToImageMenuItem

src/GUI/Gtk/Callbacks.hs

@@ -85,10 +85,10 @@ setCallbacks mygui myview = do
   _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
     [Control] <- eventModifier
     "h"       <- fmap glibToString eventKeyName
-    mcdir <- liftIO $ getFirstRow myview
+    cdir <- liftIO $ getCurrentDir myview
     liftIO $ modifyTVarIO (settings mygui)
                           (\x -> x { showHidden = not . showHidden $ x})
-             >> (refreshTreeView' mygui myview =<< goUp mcdir)
+             >> (refreshTreeView' mygui myview cdir)
   _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
     [Alt] <- eventModifier
     "Up"  <- fmap glibToString eventKeyName
@@ -117,10 +117,14 @@ setCallbacks mygui myview = do
     liftIO $ withRow mygui myview open
   _ <- menubarFileExecute mygui `on` menuItemActivated $
     liftIO $ withRow mygui myview execute
+  _ <- menubarFileNew mygui `on` menuItemActivated $
+    liftIO $ newFile mygui myview
 
   -- menubar-edit
   _ <- menubarEditCopy mygui `on` menuItemActivated $
     liftIO $ withRow mygui myview copyInit
+  _ <- menubarEditMove mygui `on` menuItemActivated $
+    liftIO $ withRow mygui myview moveInit
   _ <- menubarEditPaste mygui `on` menuItemActivated $
     liftIO $ operationFinal mygui myview
   _ <- menubarEditDelete mygui `on` menuItemActivated $
@@ -144,8 +148,12 @@ setCallbacks mygui myview = do
     liftIO $ withRow mygui myview open
   _ <- rcFileExecute mygui `on` menuItemActivated $
     liftIO $ withRow mygui myview execute
+  _ <- rcFileNew mygui `on` menuItemActivated $
+    liftIO $ newFile mygui myview
   _ <- rcFileCopy mygui `on` menuItemActivated $
     liftIO $ withRow mygui myview copyInit
+  _ <- rcFileMove mygui `on` menuItemActivated $
+    liftIO $ withRow mygui myview moveInit
   _ <- rcFilePaste mygui `on` menuItemActivated $
     liftIO $ operationFinal mygui myview
   _ <- rcFileDelete mygui `on` menuItemActivated $
@@ -221,7 +229,7 @@ copyInit row mygui myview =
 operationFinal :: MyGUI -> MyView -> IO ()
 operationFinal mygui myview = withErrorDialog $ do
   op <- readTVarIO (operationBuffer myview)
-  cdir <- goUp =<< getFirstRow myview
+  cdir <- getCurrentDir myview
   case op of
     FMove (MP1 s) -> do
       let cmsg = "Really move \"" ++ fullPath s
@@ -249,8 +257,19 @@ operationFinal mygui myview = withErrorDialog $ do
 -- * 'sortedModel' reads
 upDir :: MyGUI -> MyView -> IO ()
 upDir mygui myview = withErrorDialog $ do
-  cdir <- goUp =<< getFirstRow myview
+  cdir <- getCurrentDir myview
   rawModel'    <- readTVarIO $ rawModel myview
   sortedModel' <- readTVarIO $ sortedModel myview
   nv <- goUp cdir
   refreshTreeView' mygui myview nv
+
+
+-- |Go up one directory and visualize it in the treeView.
+newFile :: MyGUI -> MyView -> IO ()
+newFile mygui myview = withErrorDialog $ do
+  cdir <- getCurrentDir myview
+  mfn   <- fileChooserDialog
+  maybe (return ()) (\fn -> do
+    createFile cdir fn
+    refreshTreeView' mygui myview cdir
+    ) mfn

src/GUI/Gtk/Data.hs

@@ -47,16 +47,20 @@ data MyGUI = MkMyGUI {
   , menubarFileQuit :: ImageMenuItem
   , menubarFileOpen :: ImageMenuItem
   , menubarFileExecute :: ImageMenuItem
+  , menubarFileNew :: ImageMenuItem
   , menubarEditCut :: ImageMenuItem
   , menubarEditCopy :: ImageMenuItem
+  , menubarEditMove :: ImageMenuItem
   , menubarEditPaste :: ImageMenuItem
   , menubarEditDelete :: ImageMenuItem
   , menubarHelpAbout :: ImageMenuItem
   , rcMenu :: Menu
   , rcFileOpen :: ImageMenuItem
   , rcFileExecute :: ImageMenuItem
+  , rcFileNew :: ImageMenuItem
   , rcFileCut :: ImageMenuItem
   , rcFileCopy :: ImageMenuItem
+  , rcFileMove :: ImageMenuItem
   , rcFilePaste :: ImageMenuItem
   , rcFileDelete :: ImageMenuItem
   , urlBar :: Entry

src/GUI/Gtk/Dialogs.hs

@@ -158,3 +158,26 @@ withErrorDialog io = do
          (\_ -> return ())
          r
 
+
+-- |Asks the user which directory copy mode he wants via dialog popup
+-- and returns 'DirCopyMode'.
+fileChooserDialog :: IO (Maybe String)
+fileChooserDialog = do
+  chooserDialog <- messageDialogNew Nothing
+                                    [DialogDestroyWithParent]
+                                    MessageQuestion
+                                    ButtonsNone
+                                    "Enter filename"
+  entry <- entryNew
+  cbox <- dialogGetActionArea chooserDialog
+  dialogAddButton chooserDialog "Create" (ResponseUser 0)
+  dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
+  boxPackStart (castToBox cbox) entry PackNatural 5
+  widgetShowAll chooserDialog
+  rID <- dialogRun chooserDialog
+  ret <- case rID of
+           -- TODO: make this more safe
+           ResponseUser 0 -> Just <$> entryGetText entry
+           ResponseUser 1 -> return Nothing
+  widgetDestroy chooserDialog
+  return ret

src/GUI/Gtk/Utils.hs

@@ -125,6 +125,12 @@ getFirstRow myview = do
   treeModelGetRow rawModel' iter
 
 
+-- |Currently unsafe. Gets the current directory via `getFirstRow` and `goUp`.
+getCurrentDir :: MyView
+              -> IO (AnchoredFile FileInfo)
+getCurrentDir myview = getFirstRow myview >>= goUp
+
+
 -- |Re-reads the current directory or the given one and updates the TreeView.
 --
 -- The operation may fail with:

src/IO/Error.hs

@@ -63,6 +63,7 @@ data FmIOException = FileDoesNotExist String
                    | NotAFile String
                    | NotADir String
                    | DestinationInSource String String
+                   | FileDoesExist String
                    | DirDoesExist String
                    | IsSymlink String
   deriving (Show, Typeable)
@@ -87,6 +88,11 @@ throwNotAbsolute :: FilePath -> IO ()
 throwNotAbsolute fp = unless (isAbsolute fp) (throw $ PathNotAbsolute fp)
 
 
+throwFileDoesExist :: FilePath -> IO ()
+throwFileDoesExist fp =
+  whenM (doesFileExist fp) (throw $ FileDoesExist fp)
+
+
 throwDirDoesExist :: FilePath -> IO ()
 throwDirDoesExist fp =
   whenM (doesDirectoryExist fp) (throw $ DirDoesExist fp)

src/IO/File.hs

@@ -75,6 +75,19 @@ import System.Posix.Files
   , readSymbolicLink
   , fileAccess
   , getFileStatus
+  , groupReadMode
+  , groupWriteMode
+  , otherReadMode
+  , otherWriteMode
+  , ownerReadMode
+  , ownerWriteMode
+  , touchFile
+  , unionFileModes
+  )
+import System.Posix.IO
+  (
+    closeFd
+  , createFile
   )
 import System.Process
   (
@@ -374,3 +387,27 @@ executeFile :: AnchoredFile FileInfo  -- ^ program
 executeFile prog@(_ :/ RegFile {}) args
   = Just <$> spawnProcess (fullPath prog) args
 executeFile _ _      = return Nothing
+
+
+
+
+    ---------------------
+    --[ File Creation ]--
+    ---------------------
+
+
+createFile :: AnchoredFile FileInfo -> FileName -> IO ()
+createFile _ "."  = return ()
+createFile _ ".." = return ()
+createFile (SADir td) fn = do
+  let fullp = fullPath td </> fn
+  throwFileDoesExist fullp
+  let uf   = unionFileModes
+      mode =      ownerWriteMode
+             `uf` ownerReadMode
+             `uf` groupWriteMode
+             `uf` groupReadMode
+             `uf` otherWriteMode
+             `uf` otherReadMode
+  fd <- System.Posix.IO.createFile fullp mode
+  closeFd fd