LIB/GTK: cleanup compiler warnings
This commit is contained in:
parent
65595fa9c5
commit
4da3c92e5e
@ -54,6 +54,7 @@ library
|
||||
ghc-options:
|
||||
-O2
|
||||
-threaded
|
||||
-Wall
|
||||
"-with-rtsopts=-N"
|
||||
|
||||
executable hsfm-gtk
|
||||
@ -62,6 +63,7 @@ executable hsfm-gtk
|
||||
HSFM.GUI.Gtk.Callbacks
|
||||
HSFM.GUI.Gtk.Data
|
||||
HSFM.GUI.Gtk.Dialogs
|
||||
HSFM.GUI.Gtk.Errors
|
||||
HSFM.GUI.Gtk.Icons
|
||||
HSFM.GUI.Gtk.MyGUI
|
||||
HSFM.GUI.Gtk.MyView
|
||||
@ -97,4 +99,5 @@ executable hsfm-gtk
|
||||
ghc-options:
|
||||
-O2
|
||||
-threaded
|
||||
-Wall
|
||||
"-with-rtsopts=-N"
|
||||
|
||||
@ -29,10 +29,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module HSFM.FileSystem.FileOperations where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<$>)
|
||||
)
|
||||
import Control.Exception
|
||||
(
|
||||
throw
|
||||
@ -58,11 +54,6 @@ import qualified HPath as P
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.Utils.IO
|
||||
import HSFM.Utils.MyPrelude
|
||||
import System.FilePath
|
||||
(
|
||||
(</>)
|
||||
)
|
||||
import System.Posix.Directory
|
||||
(
|
||||
createDirectory
|
||||
@ -158,6 +149,7 @@ runFileOp (FMove fo) = return $ Just $ FMove fo
|
||||
runFileOp (FDelete fp) = easyDelete fp >> return Nothing
|
||||
runFileOp (FOpen fp) = openFile fp >> return Nothing
|
||||
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
|
||||
runFileOp _ = return Nothing
|
||||
|
||||
|
||||
|
||||
@ -175,7 +167,7 @@ copyDir :: CopyMode
|
||||
-> IO ()
|
||||
copyDir _ AFileInvFN _ = throw InvalidFileName
|
||||
copyDir _ _ AFileInvFN = throw InvalidFileName
|
||||
copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
|
||||
copyDir cm from@(_ :/ Dir fromn FileInfo{ fileMode = fmode })
|
||||
to@(_ :/ Dir {})
|
||||
= do
|
||||
let fromp = fullPath from
|
||||
@ -196,20 +188,20 @@ copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
|
||||
(_ :/ RegFile {}) -> copyFileToDir Replace f destdir
|
||||
_ -> return ()
|
||||
where
|
||||
createDestdir destdir fmode =
|
||||
createDestdir destdir fmode' =
|
||||
let destdir' = P.toFilePath destdir
|
||||
in case cm of
|
||||
Merge ->
|
||||
unlessM (doesDirectoryExist destdir)
|
||||
(createDirectory destdir' fmode)
|
||||
(createDirectory destdir' fmode')
|
||||
Strict -> do
|
||||
throwDirDoesExist destdir
|
||||
createDirectory destdir' fmode
|
||||
createDirectory destdir' fmode'
|
||||
Replace -> do
|
||||
whenM (doesDirectoryExist destdir)
|
||||
(deleteDirRecursive =<<
|
||||
HSFM.FileSystem.FileType.readFileWithFileInfo destdir)
|
||||
createDirectory destdir' fmode
|
||||
createDirectory destdir' fmode'
|
||||
copyDir _ _ _ = throw $ InvalidOperation "wrong input type"
|
||||
|
||||
|
||||
@ -295,14 +287,14 @@ easyCopy :: CopyMode
|
||||
-> AnchoredFile FileInfo
|
||||
-> AnchoredFile FileInfo
|
||||
-> IO ()
|
||||
easyCopy cm from@(_ :/ SymLink {})
|
||||
to@(_ :/ Dir {})
|
||||
easyCopy cm from@(_ :/ SymLink{})
|
||||
to@(_ :/ Dir{})
|
||||
= recreateSymlink cm from to
|
||||
easyCopy cm from@(_ :/ RegFile fn _)
|
||||
to@(_ :/ Dir {})
|
||||
easyCopy cm from@(_ :/ RegFile{})
|
||||
to@(_ :/ Dir{})
|
||||
= copyFileToDir cm from to
|
||||
easyCopy cm from@(_ :/ Dir fn _)
|
||||
to@(_ :/ Dir {})
|
||||
easyCopy cm from@(_ :/ Dir{})
|
||||
to@(_ :/ Dir{})
|
||||
= copyDir cm from to
|
||||
easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
|
||||
|
||||
|
||||
@ -26,17 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module HSFM.FileSystem.FileType where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<*>)
|
||||
, (<$>)
|
||||
, (<|>)
|
||||
, pure
|
||||
)
|
||||
import Control.Arrow
|
||||
(
|
||||
first
|
||||
)
|
||||
|
||||
import Control.Exception
|
||||
(
|
||||
handle
|
||||
@ -53,86 +43,38 @@ import Control.Monad.State.Lazy
|
||||
import Data.Default
|
||||
import Data.List
|
||||
(
|
||||
delete
|
||||
, foldl'
|
||||
, isPrefixOf
|
||||
, sort
|
||||
, sortBy
|
||||
, (\\)
|
||||
isPrefixOf
|
||||
)
|
||||
import Data.Maybe
|
||||
(
|
||||
catMaybes
|
||||
, fromMaybe
|
||||
)
|
||||
import Data.Ord
|
||||
(
|
||||
comparing
|
||||
)
|
||||
import Data.Time.Clock.POSIX
|
||||
(
|
||||
POSIXTime
|
||||
, posixSecondsToUTCTime
|
||||
)
|
||||
import Data.Time
|
||||
(
|
||||
UTCTime(..)
|
||||
)
|
||||
import Data.Traversable
|
||||
(
|
||||
for
|
||||
)
|
||||
import Data.Word
|
||||
(
|
||||
Word64
|
||||
)
|
||||
import Data.Time()
|
||||
import HPath
|
||||
(
|
||||
Abs
|
||||
, Path
|
||||
, Fn
|
||||
, Rel
|
||||
, pattern Path
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HSFM.Utils.MyPrelude
|
||||
import Safe
|
||||
(
|
||||
atDef
|
||||
, initDef
|
||||
)
|
||||
import System.FilePath
|
||||
(
|
||||
combine
|
||||
, normalise
|
||||
, equalFilePath
|
||||
, isAbsolute
|
||||
, joinPath
|
||||
isAbsolute
|
||||
, pathSeparator
|
||||
, splitDirectories
|
||||
, takeFileName
|
||||
, (</>)
|
||||
)
|
||||
import System.IO
|
||||
(
|
||||
IOMode
|
||||
, Handle
|
||||
, openFile
|
||||
)
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
, isDoesNotExistErrorType
|
||||
)
|
||||
import System.IO.Unsafe
|
||||
(
|
||||
unsafeInterleaveIO
|
||||
)
|
||||
import System.Locale
|
||||
(
|
||||
defaultTimeLocale
|
||||
, rfc822DateFormat
|
||||
)
|
||||
import System.Posix.Types
|
||||
(
|
||||
DeviceID
|
||||
@ -237,7 +179,7 @@ data FileInfo = FileInfo {
|
||||
convertViewP :: (File FileInfo -> (Bool, File FileInfo))
|
||||
-> AnchoredFile FileInfo
|
||||
-> (Bool, AnchoredFile FileInfo)
|
||||
convertViewP f af@(bp :/ constr) =
|
||||
convertViewP f (bp :/ constr) =
|
||||
let (b, file) = f constr
|
||||
in (b, bp :/ file)
|
||||
|
||||
@ -260,7 +202,7 @@ sfileLike f = fileLikeSym f
|
||||
|
||||
|
||||
afileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
|
||||
afileLike f@(bp :/ constr) = convertViewP fileLike f
|
||||
afileLike f = convertViewP fileLike f
|
||||
|
||||
|
||||
fileLike :: File FileInfo -> (Bool, File FileInfo)
|
||||
@ -312,7 +254,7 @@ invalidFileName :: Path Fn -> (Bool, Path Fn)
|
||||
invalidFileName p@(Path "") = (True, p)
|
||||
invalidFileName p@(Path ".") = (True, p)
|
||||
invalidFileName p@(Path "..") = (True, p)
|
||||
invalidFileName p@(Path fn) = (elem pathSeparator fn, p)
|
||||
invalidFileName p = (elem pathSeparator (P.fromRel p), p)
|
||||
|
||||
|
||||
-- |Matches on invalid filesnames, such as ".", ".." and anything
|
||||
@ -472,8 +414,6 @@ readWith ff p = do
|
||||
-- TODO: could it happen that too many '..' lead
|
||||
-- to something like '/' after normalization?
|
||||
let sfp = if isAbsolute x then x else (P.fromAbs bd') </> x
|
||||
sf <- PF.getFileStatus sfp -- important to break infinite symbolic
|
||||
-- link cycle
|
||||
rsfp <- P.realPath sfp
|
||||
readWith ff =<< P.parseAbs rsfp
|
||||
return $ SymLink fn' fv resolvedSyml x
|
||||
@ -733,7 +673,7 @@ removeNonexistent = filter isOkConstructor
|
||||
--
|
||||
-- When called on a non-symlink, returns False.
|
||||
isBrokenSymlink :: File FileInfo -> Bool
|
||||
isBrokenSymlink af@(SymLink _ _ (_ :/ Failed {}) _) = True
|
||||
isBrokenSymlink (SymLink _ _ (_ :/ Failed {}) _) = True
|
||||
isBrokenSymlink _ = False
|
||||
|
||||
|
||||
@ -744,7 +684,7 @@ isBrokenSymlink _ = False
|
||||
hiddenFile :: Path Fn -> Bool
|
||||
hiddenFile (Path ".") = False
|
||||
hiddenFile (Path "..") = False
|
||||
hiddenFile (Path fn) = "." `isPrefixOf` fn
|
||||
hiddenFile p = "." `isPrefixOf` (P.fromRel p)
|
||||
|
||||
|
||||
-- |Apply a function on the free variable. If there is no free variable
|
||||
@ -798,6 +738,7 @@ packPermissions dt = fromFreeVar (pStr . fileMode) dt
|
||||
CharDev {} -> "c"
|
||||
NamedPipe {} -> "p"
|
||||
Socket {} -> "s"
|
||||
_ -> "?"
|
||||
ownerModeStr = hasFmStr PF.ownerReadMode "r"
|
||||
++ hasFmStr PF.ownerWriteMode "w"
|
||||
++ hasFmStr PF.ownerExecuteMode "x"
|
||||
|
||||
@ -21,11 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module HSFM.GUI.Gtk.Callbacks where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<$>)
|
||||
, (<*>)
|
||||
)
|
||||
import Control.Concurrent.STM
|
||||
(
|
||||
readTVarIO
|
||||
@ -62,11 +57,6 @@ import HSFM.GUI.Gtk.Dialogs
|
||||
import HSFM.GUI.Gtk.MyView
|
||||
import HSFM.GUI.Gtk.Utils
|
||||
import HSFM.Utils.IO
|
||||
import System.FilePath
|
||||
(
|
||||
isAbsolute
|
||||
, (</>)
|
||||
)
|
||||
import System.Glib.UTFString
|
||||
(
|
||||
glibToString
|
||||
@ -225,7 +215,7 @@ open [item] mygui myview = withErrorDialog $
|
||||
r ->
|
||||
void $ openFile r
|
||||
-- this throws on the first error that occurs
|
||||
open (FileLikeList fs) mygui myview = withErrorDialog $
|
||||
open (FileLikeList fs) _ _ = withErrorDialog $
|
||||
forM_ fs $ \f -> void $ openFile f
|
||||
open _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
@ -234,7 +224,7 @@ open _ _ _ = withErrorDialog
|
||||
|
||||
-- |Execute a given file.
|
||||
execute :: [Item] -> MyGUI -> MyView -> IO ()
|
||||
execute [item] mygui myview = withErrorDialog $
|
||||
execute [item] _ _ = withErrorDialog $
|
||||
void $ executeFile item []
|
||||
execute _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
@ -243,12 +233,12 @@ execute _ _ _ = withErrorDialog
|
||||
|
||||
-- |Supposed to be used with 'withRows'. Deletes a file or directory.
|
||||
del :: [Item] -> MyGUI -> MyView -> IO ()
|
||||
del [item] mygui myview = withErrorDialog $ do
|
||||
del [item] _ _ = withErrorDialog $ do
|
||||
let cmsg = "Really delete \"" ++ fullPathS item ++ "\"?"
|
||||
withConfirmationDialog cmsg
|
||||
$ easyDelete item
|
||||
-- this throws on the first error that occurs
|
||||
del items@(_:_) mygui myview = withErrorDialog $ do
|
||||
del items@(_:_) _ _ = withErrorDialog $ do
|
||||
let cmsg = "Really delete " ++ show (length items) ++ " files?"
|
||||
withConfirmationDialog cmsg
|
||||
$ forM_ items $ \item -> easyDelete item
|
||||
@ -282,7 +272,7 @@ copyInit _ _ _ = withErrorDialog
|
||||
|
||||
-- |Finalizes a file operation, such as copy or move.
|
||||
operationFinal :: MyGUI -> MyView -> IO ()
|
||||
operationFinal mygui myview = withErrorDialog $ do
|
||||
operationFinal _ myview = withErrorDialog $ do
|
||||
op <- readTVarIO (operationBuffer myview)
|
||||
cdir <- getCurrentDir myview
|
||||
case op of
|
||||
@ -305,15 +295,13 @@ operationFinal mygui myview = withErrorDialog $ do
|
||||
upDir :: MyGUI -> MyView -> IO ()
|
||||
upDir mygui myview = withErrorDialog $ do
|
||||
cdir <- getCurrentDir myview
|
||||
rawModel' <- readTVarIO $ rawModel myview
|
||||
sortedModel' <- readTVarIO $ sortedModel myview
|
||||
nv <- goUp cdir
|
||||
refreshView' mygui myview nv
|
||||
|
||||
|
||||
-- |Go up one directory and visualize it in the treeView.
|
||||
newFile :: MyGUI -> MyView -> IO ()
|
||||
newFile mygui myview = withErrorDialog $ do
|
||||
newFile _ myview = withErrorDialog $ do
|
||||
mfn <- textInputDialog "Enter file name"
|
||||
let pmfn = P.parseFn =<< mfn
|
||||
for_ pmfn $ \fn -> do
|
||||
@ -322,7 +310,7 @@ newFile mygui myview = withErrorDialog $ do
|
||||
|
||||
|
||||
renameF :: [Item] -> MyGUI -> MyView -> IO ()
|
||||
renameF [item] mygui myview = withErrorDialog $ do
|
||||
renameF [item] _ _ = withErrorDialog $ do
|
||||
mfn <- textInputDialog "Enter new file name"
|
||||
let pmfn = P.parseFn =<< mfn
|
||||
for_ pmfn $ \fn -> do
|
||||
|
||||
@ -21,10 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module HSFM.GUI.Gtk.Dialogs where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<$>)
|
||||
)
|
||||
import Control.Exception
|
||||
(
|
||||
catch
|
||||
@ -35,7 +31,6 @@ import Control.Exception
|
||||
import Control.Monad
|
||||
(
|
||||
when
|
||||
, void
|
||||
)
|
||||
import Data.Version
|
||||
(
|
||||
@ -62,7 +57,7 @@ import Distribution.Verbosity
|
||||
import Graphics.UI.Gtk
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HSFM.GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.Errors
|
||||
import Paths_hsfm
|
||||
(
|
||||
getDataFileName
|
||||
@ -113,15 +108,16 @@ showCopyModeDialog = do
|
||||
MessageQuestion
|
||||
ButtonsNone
|
||||
"Target exists, how to proceed?"
|
||||
dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
|
||||
dialogAddButton chooserDialog "Merge" (ResponseUser 1)
|
||||
dialogAddButton chooserDialog "Replace" (ResponseUser 2)
|
||||
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
|
||||
_ <- dialogAddButton chooserDialog "Merge" (ResponseUser 1)
|
||||
_ <- dialogAddButton chooserDialog "Replace" (ResponseUser 2)
|
||||
rID <- dialogRun chooserDialog
|
||||
widgetDestroy chooserDialog
|
||||
case rID of
|
||||
ResponseUser 0 -> return Strict
|
||||
ResponseUser 1 -> return Merge
|
||||
ResponseUser 2 -> return Replace
|
||||
_ -> throw UnknownDialogButton
|
||||
|
||||
|
||||
-- |Attempts to run the given function with the `Strict` copy mode.
|
||||
@ -134,7 +130,7 @@ withCopyModeDialog fa =
|
||||
case e of
|
||||
FileDoesExist _ -> doIt
|
||||
DirDoesExist _ -> doIt
|
||||
e -> throw e
|
||||
e' -> throw e'
|
||||
where
|
||||
doIt = do cm <- showCopyModeDialog
|
||||
case cm of
|
||||
@ -196,8 +192,8 @@ textInputDialog title = do
|
||||
title
|
||||
entry <- entryNew
|
||||
cbox <- dialogGetActionArea chooserDialog
|
||||
dialogAddButton chooserDialog "Ok" (ResponseUser 0)
|
||||
dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
|
||||
_ <- dialogAddButton chooserDialog "Ok" (ResponseUser 0)
|
||||
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
|
||||
boxPackStart (castToBox cbox) entry PackNatural 5
|
||||
widgetShowAll chooserDialog
|
||||
rID <- dialogRun chooserDialog
|
||||
@ -205,5 +201,6 @@ textInputDialog title = do
|
||||
-- TODO: make this more safe
|
||||
ResponseUser 0 -> Just <$> entryGetText entry
|
||||
ResponseUser 1 -> return Nothing
|
||||
_ -> throw UnknownDialogButton
|
||||
widgetDestroy chooserDialog
|
||||
return ret
|
||||
|
||||
34
src/HSFM/GUI/Gtk/Errors.hs
Normal file
34
src/HSFM/GUI/Gtk/Errors.hs
Normal file
@ -0,0 +1,34 @@
|
||||
{--
|
||||
HSFM, a filemanager written in Haskell.
|
||||
Copyright (C) 2016 Julian Ospald
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
version 2 as published by the Free Software Foundation.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
--}
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
-- |Provides error handling for Gtk.
|
||||
module HSFM.GUI.Gtk.Errors where
|
||||
|
||||
|
||||
import Control.Exception
|
||||
import Data.Typeable
|
||||
|
||||
|
||||
|
||||
data GtkException = UnknownDialogButton
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance Exception GtkException
|
||||
|
||||
@ -27,7 +27,6 @@ import Data.Maybe
|
||||
fromJust
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import Graphics.UI.Gtk.Gdk.Pixbuf
|
||||
import Paths_hsfm
|
||||
(
|
||||
getDataFileName
|
||||
|
||||
@ -110,6 +110,7 @@ createMyGUI = do
|
||||
let mygui = MkMyGUI {..}
|
||||
|
||||
-- sets the default icon
|
||||
windowSetDefaultIconFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png"
|
||||
_ <- windowSetDefaultIconFromFile
|
||||
=<< getDataFileName "data/Gtk/icons/hsfm.png"
|
||||
|
||||
return mygui
|
||||
|
||||
@ -21,10 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module HSFM.GUI.Gtk.MyView where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<$>)
|
||||
)
|
||||
import Control.Concurrent.MVar
|
||||
(
|
||||
newEmptyMVar
|
||||
@ -41,10 +37,6 @@ import Control.Exception
|
||||
try
|
||||
, SomeException
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
when
|
||||
)
|
||||
import Data.Foldable
|
||||
(
|
||||
for_
|
||||
@ -64,17 +56,12 @@ import HSFM.GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.Icons
|
||||
import HSFM.GUI.Gtk.Utils
|
||||
import HSFM.Utils.IO
|
||||
import System.FilePath
|
||||
(
|
||||
isAbsolute
|
||||
)
|
||||
import System.INotify
|
||||
(
|
||||
addWatch
|
||||
, initINotify
|
||||
, killINotify
|
||||
, EventVariety(..)
|
||||
, Event(..)
|
||||
)
|
||||
import System.IO.Error
|
||||
(
|
||||
@ -218,19 +205,19 @@ refreshView mygui myview mfp =
|
||||
-- readFileWithFileInfo can just outright fail...
|
||||
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo mdir)
|
||||
case ecdir of
|
||||
Right cdir -> do
|
||||
Right cdir ->
|
||||
-- ...or return an `AnchordFile` with a Failed constructor,
|
||||
-- both of which need to be handled here
|
||||
if (failed . file $ cdir)
|
||||
then refreshView mygui myview =<< getAlternativeDir
|
||||
else refreshView' mygui myview cdir
|
||||
Left e -> refreshView mygui myview =<< getAlternativeDir
|
||||
Left _ -> refreshView mygui myview =<< getAlternativeDir
|
||||
Nothing -> refreshView mygui myview =<< getAlternativeDir
|
||||
where
|
||||
getAlternativeDir = do
|
||||
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
|
||||
(AnchoredFile FileInfo))
|
||||
case (ecd) of
|
||||
case ecd of
|
||||
Right dir -> return (Just $ fullPathS dir)
|
||||
Left _ -> return (Just "/")
|
||||
|
||||
@ -285,13 +272,13 @@ constructView mygui myview = do
|
||||
filePix <- getIcon IFile iT (iconSize settings')
|
||||
fileSymPix <- getSymlinkIcon IFile iT (iconSize settings')
|
||||
errorPix <- getIcon IError iT (iconSize settings')
|
||||
let dirtreePix (Dir {}) = folderPix
|
||||
dirtreePix (FileLike {}) = filePix
|
||||
dirtreePix (DirSym _) = folderSymPix
|
||||
dirtreePix (FileLikeSym {}) = fileSymPix
|
||||
dirtreePix (Failed {}) = errorPix
|
||||
dirtreePix (BrokenSymlink _) = errorPix
|
||||
dirtreePix _ = errorPix
|
||||
let dirtreePix Dir{} = folderPix
|
||||
dirtreePix FileLike{} = filePix
|
||||
dirtreePix DirSym{} = folderSymPix
|
||||
dirtreePix FileLikeSym{} = fileSymPix
|
||||
dirtreePix Failed{} = errorPix
|
||||
dirtreePix BrokenSymlink{} = errorPix
|
||||
dirtreePix _ = errorPix
|
||||
|
||||
|
||||
view' <- readTVarIO $ view myview
|
||||
@ -350,7 +337,7 @@ constructView mygui myview = do
|
||||
mi <- tryTakeMVar (inotify myview)
|
||||
for_ mi $ \i -> killINotify i
|
||||
newi <- initINotify
|
||||
w <- addWatch
|
||||
_ <- addWatch
|
||||
newi
|
||||
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
|
||||
(P.fromAbs cdirp)
|
||||
|
||||
@ -21,10 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
module HSFM.GUI.Gtk.Utils where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
(
|
||||
(<$>)
|
||||
)
|
||||
import Control.Concurrent.STM
|
||||
(
|
||||
readTVarIO
|
||||
@ -73,7 +69,7 @@ getSelectedItems' :: MyGUI
|
||||
-> MyView
|
||||
-> [TreePath]
|
||||
-> IO [Item]
|
||||
getSelectedItems' mygui myview tps = do
|
||||
getSelectedItems' _ myview tps = do
|
||||
rawModel' <- readTVarIO $ rawModel myview
|
||||
sortedModel' <- readTVarIO $ sortedModel myview
|
||||
filteredModel' <- readTVarIO $ filteredModel myview
|
||||
@ -107,7 +103,7 @@ withItems mygui myview io = do
|
||||
fileListStore :: AnchoredFile FileInfo -- ^ current dir
|
||||
-> MyView
|
||||
-> IO (ListStore Item)
|
||||
fileListStore dt myview = do
|
||||
fileListStore dt _ = do
|
||||
cs <- HSFM.FileSystem.FileType.getContents dt
|
||||
listStoreNew cs
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user