aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Config.hs58
-rw-r--r--Screen.hs12
-rw-r--r--State.hs2
3 files changed, 56 insertions, 16 deletions
diff --git a/Config.hs b/Config.hs
index 5c4e477..26c062d 100644
--- a/Config.hs
+++ b/Config.hs
@@ -8,23 +8,29 @@
module Config(LazymailConfig(..), defaultConfig, customConfig) where
+import Data.List(sort, stripPrefix)
+import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator)
+import System.Posix.Files(getSymbolicLinkStatus, isSymbolicLink)
import UI.NCurses(Color(..))
-import System.FilePath(FilePath)
data LazymailConfig = LazymailConfig {
- baseColor :: (Color, Color) -- (foreground, background)
- , selectionColor :: (Color, Color)
- , statusBarColor :: (Color, Color)
- , showStatusBar :: Bool
- , initialPath :: FilePath
+ baseColor :: (Color, Color) -- (foreground, background)
+ , selectionColor :: (Color, Color)
+ , statusBarColor :: (Color, Color)
+ , showStatusBar :: Bool
+ , initialPath :: FilePath
+ , filterMaildirsHook :: [FilePath] -> IO [FilePath]
+ , maildirDrawHook :: String -> String -> String
}
defaultConfig = LazymailConfig {
- baseColor = (ColorWhite, ColorBlack)
- , selectionColor = (ColorBlack, ColorWhite)
- , statusBarColor = (ColorBlack, ColorWhite)
- , showStatusBar = True
- , initialPath = ""
+ baseColor = (ColorWhite, ColorBlack)
+ , selectionColor = (ColorBlack, ColorWhite)
+ , statusBarColor = (ColorBlack, ColorWhite)
+ , showStatusBar = True
+ , initialPath = ""
+ , filterMaildirsHook = \mds -> return mds
+ , maildirDrawHook = \_ md -> md
}
--
@@ -32,4 +38,32 @@ defaultConfig = LazymailConfig {
-- preferences. In a possible future maybe I'll work in a not-so-crappy
-- config system.
--
-customConfig = defaultConfig { initialPath = "/home/rul/mail/linti/" } \ No newline at end of file
+--customConfig = defaultConfig { initialPath = "/home/rul/mail/"}
+
+
+customConfig = defaultConfig { initialPath = "/home/rul/mail/linti"
+ , maildirDrawHook = indentedShow
+ , filterMaildirsHook = filterSymlinks }
+
+indentedShow :: String -> String -> String
+indentedShow bp md =
+ let str = case (stripPrefix bp md) of
+ Nothing -> md
+ Just s -> s
+ name' = takeFileName . dropTrailingPathSeparator $ str
+ name = takeFileName $ map (\x -> if x `elem` imapSep then '/' else x) name'
+ pad = " "
+ numPads = (length $ filter (== '/') str) + (length $ filter (`elem` imapSep) str)
+ imapSep = ['.'] -- IMAP usually separates its directories with dots
+ in (concat $ replicate (numPads - 1) pad) ++ pad ++ name
+
+filterSymlinks :: [FilePath] -> IO [FilePath]
+filterSymlinks [] = return []
+filterSymlinks (md:mds) = do
+ filtered <- do
+ fs <- getSymbolicLinkStatus md
+ rest <- filterSymlinks mds
+ if isSymbolicLink fs
+ then return rest
+ else return (md:rest)
+ return $ sort filtered \ No newline at end of file
diff --git a/Screen.hs b/Screen.hs
index 919585e..c8ef25a 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -34,9 +34,11 @@ liftUpdate = lift . lift
entryPoint :: Lazymail ()
entryPoint = do
st <- get
- maildirs <- liftIO $ getMaildirsRecursively $ basePath st
- let mdState = (maildirState st) { detectedMDs = maildirs }
cfg <- ask
+ maildirs <- liftIO $ do
+ mds <- getMaildirsRecursively $ basePath st
+ (filterMaildirsHook cfg) mds
+ let mdState = (maildirState st) { detectedMDs = maildirs }
liftIO $ runCurses $ runStateT (runReaderT startCurses cfg) (st { maildirState = mdState })
return ()
@@ -88,16 +90,18 @@ drawMaildirHelper :: [FilePath] -> LazymailUpdate ()
drawMaildirHelper [] = resetCurrentRow
drawMaildirHelper (md:mds) = do
st <- get
+ cfg <- ask
+ let ppMd = (maildirDrawHook cfg) (basePath st) md
liftUpdate $ moveCursor (curRowAsInteger st) (colPadAsInteger st)
if (selectedRow st == currentRow st)
then do
liftUpdate $ do
setColor $ selectionColorID . colorStyle $ st
- drawString $ normalizeLen (screenColumns st) md
+ drawString $ normalizeLen (screenColumns st) ppMd
setColor $ baseColorID . colorStyle $ st
let maildirState' = (maildirState st) { selectedMD = md }
put $ st { maildirState = maildirState' }
- else liftUpdate $ drawString $ normalizeLen (screenColumns st) md
+ else liftUpdate $ drawString $ normalizeLen (screenColumns st) ppMd
st <- get
let limit = if statusBar st then (screenRows st) - 1 else screenRows st
diff --git a/State.hs b/State.hs
index 7ff8359..57b6258 100644
--- a/State.hs
+++ b/State.hs
@@ -108,6 +108,7 @@ incrementSelectedRow st | (selectedRow st) < limit = case (mode st) of
indexState' = (indexState st) { selectedRowIn = sr + 1 }
in
st { indexState = indexState' }
+ _ -> st
| otherwise = st
where
limit' = case (mode st) of
@@ -130,6 +131,7 @@ decrementSelectedRow st | (selectedRow st) > 0 = case (mode st) of
indexState' = (indexState st) { selectedRowIn = sr - 1 }
in
st { indexState = indexState' }
+ _ -> st
| otherwise = st
selectedRow st = case (mode st) of
nihil fit ex nihilo