diff --git a/src/GUI/Gtk.hs b/src/GUI/Gtk.hs index dd404c0..c86c139 100644 --- a/src/GUI/Gtk.hs +++ b/src/GUI/Gtk.hs @@ -155,10 +155,12 @@ startMainWindow startdir = do inotify <- newEmptyMVar -- get the icons - iT <- iconThemeGetDefault - folderPix <- getIcon IFolder 24 - filePix <- getIcon IFile 24 - errorPix <- getIcon IError 24 + iT <- iconThemeGetDefault + folderPix <- getIcon IFolder iT 24 + folderSymPix <- getSymlinkIcon IFolder iT 24 + filePix <- getIcon IFile iT 24 + fileSymPix <- getSymlinkIcon IFile iT 24 + errorPix <- getIcon IError iT 24 operationBuffer <- newTVarIO None diff --git a/src/GUI/Gtk/Data.hs b/src/GUI/Gtk/Data.hs index c1d364a..52dfa72 100644 --- a/src/GUI/Gtk/Data.hs +++ b/src/GUI/Gtk/Data.hs @@ -82,7 +82,9 @@ data MyGUI = MkMyGUI { , renderPix :: CellRendererPixbuf , settings :: TVar FMSettings , folderPix :: Pixbuf + , folderSymPix :: Pixbuf , filePix :: Pixbuf + , fileSymPix :: Pixbuf , errorPix :: Pixbuf } diff --git a/src/GUI/Gtk/Icons.hs b/src/GUI/Gtk/Icons.hs index 88d3ac5..a7de7dc 100644 --- a/src/GUI/Gtk/Icons.hs +++ b/src/GUI/Gtk/Icons.hs @@ -28,6 +28,7 @@ import Graphics.UI.Gtk.Gdk.Pixbuf -- |Icon type we use in our GUI. data GtkIcon = IFolder + | SymL | IFile | IError @@ -35,12 +36,12 @@ data GtkIcon = IFolder -- |Gets an icon from the default icon theme and falls back to project-icons -- if not found. The requested icon size is not guaranteed. getIcon :: GtkIcon -- ^ icon we want + -> IconTheme -- ^ which icon theme to get the icon from -> Int -- ^ requested icon size -> IO Pixbuf -getIcon icon isize = do +getIcon icon itheme isize = do let iname = iconToStr icon - iT <- iconThemeGetDefault - mpix <- iconThemeLoadIcon iT iname isize IconLookupUseBuiltin + mpix <- iconThemeLoadIcon itheme iname isize IconLookupUseBuiltin case mpix of Just pix -> return pix Nothing -> pixbufNewFromFile ("data/Gtk/icons/" ++ iname) @@ -48,3 +49,14 @@ getIcon icon isize = do iconToStr IFolder = "gtk-directory" iconToStr IFile = "gtk-file" iconToStr IError = "error" + iconToStr SymL = "emblem-symbolic-link" + + +getSymlinkIcon :: GtkIcon -> IconTheme -> Int -> IO Pixbuf +getSymlinkIcon icon itheme isize = do + pix <- pixbufCopy =<< getIcon icon itheme isize + sympix <- getIcon SymL itheme isize + + pixbufScale sympix pix 0 0 12 12 0 0 0.5 0.5 InterpNearest + + return pix diff --git a/src/GUI/Gtk/Utils.hs b/src/GUI/Gtk/Utils.hs index 50c808d..4970c1b 100644 --- a/src/GUI/Gtk/Utils.hs +++ b/src/GUI/Gtk/Utils.hs @@ -276,10 +276,12 @@ constructTreeView mygui myview = do return () where - dirtreePix (Dir {}) = folderPix mygui - dirtreePix (RegFile {}) = filePix mygui - dirtreePix (Failed {}) = errorPix mygui - dirtreePix _ = errorPix mygui + dirtreePix (Dir {}) = folderPix mygui + dirtreePix (RegFile {}) = filePix mygui + dirtreePix (SDir _) = folderSymPix mygui + dirtreePix (SRegFile {}) = fileSymPix mygui + dirtreePix (Failed {}) = errorPix mygui + dirtreePix _ = errorPix mygui -- |Push a message to the status bar.