diff options
| -rw-r--r-- | Config.hs | 16 | ||||
| -rw-r--r-- | Handlers.hs | 14 | ||||
| -rw-r--r-- | Screen.hs | 62 | ||||
| -rw-r--r-- | State.hs | 2 |
4 files changed, 35 insertions, 59 deletions
@@ -9,7 +9,6 @@ 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(..)) @@ -20,7 +19,6 @@ data LazymailConfig = LazymailConfig { , showStatusBar :: Bool , initialPath :: FilePath , filterMaildirsHook :: [FilePath] -> IO [FilePath] - , maildirDrawHook :: String -> String -> String } defaultConfig = LazymailConfig { @@ -30,7 +28,6 @@ defaultConfig = LazymailConfig { , showStatusBar = True , initialPath = "" , filterMaildirsHook = \mds -> return mds - , maildirDrawHook = \_ md -> md } -- @@ -41,21 +38,8 @@ defaultConfig = LazymailConfig { --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) ++ name - filterSymlinks :: [FilePath] -> IO [FilePath] filterSymlinks [] = return [] filterSymlinks (md:mds) = do diff --git a/Handlers.hs b/Handlers.hs index 9777b3c..007933d 100644 --- a/Handlers.hs +++ b/Handlers.hs @@ -8,6 +8,8 @@ module Handlers where import Control.Monad.State +import Data.List(stripPrefix) +import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator) import Email(parseEmail, getFields, getSubject, getFrom) import Maildir @@ -93,3 +95,15 @@ formatIndexModeRows st = mapM formatRow where , (ppSep ++) $ ppIndexSubject . getSubject $ fs ] return (fp, str) + +formatMaildirModeRows st = mapM formatRow where + formatRow fp = return $ (fp, (concat $ replicate (numPads - 1) pad) ++ name) where + bp = basePath st + str = case (stripPrefix bp fp) of + Nothing -> fp + 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 @@ -35,7 +35,8 @@ entryPoint = do maildirs <- liftIO $ do mds <- getMaildirsRecursively $ basePath st (filterMaildirsHook cfg) mds - let mdState = (maildirState st) { detectedMDs = maildirs } + formattedMDs <- EH.formatMaildirModeRows st maildirs + let mdState = (maildirState st) { detectedMDs = formattedMDs } liftIO $ runCurses $ runStateT (runReaderT startCurses cfg) (st { maildirState = mdState }) return () @@ -78,27 +79,29 @@ performUpdate = do {- Pattern match on the received mode and draw it in the screen. -} drawMode :: Mode -> LazymailUpdate () -drawMode MaildirMode = get >>= \st -> drawMaildirHelper $ detectedMDs . maildirState $ st -drawMode IndexMode = get >>= \st -> drawIndexHelper $ scrollBufferIn . indexState $ st +drawMode MaildirMode = get >>= \st -> drawSelectionList $ detectedMDs . maildirState $ st +drawMode IndexMode = get >>= \st -> drawSelectionList $ scrollBufferIn . indexState $ st drawMode EmailMode = drawEmailHelper -{- Helper function of drawMode -} -drawMaildirHelper :: [FilePath] -> LazymailUpdate () -drawMaildirHelper [] = resetCurrentRow -drawMaildirHelper (md:mds) = do +drawSelectionList ((path, str):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 + (=<<) put $ liftUpdate $ do + moveCursor (curRowAsInteger st) (colPadAsInteger st) + if (selectedRow st == currentRow st) + then do setColor $ selectionColorID . colorStyle $ st - drawString $ normalizeLen (screenColumns st) ppMd + drawString $ normalizeLen (screenColumns st) str setColor $ baseColorID . colorStyle $ st - let maildirState' = (maildirState st) { selectedMD = md } - put $ st { maildirState = maildirState' } - else liftUpdate $ drawString $ normalizeLen (screenColumns st) ppMd + case (mode st) of + MaildirMode -> do + let mst = (maildirState st) { selectedMD = path } + return $ st { maildirState = mst } + IndexMode -> do + let ist = (indexState st) { selectedEmailPath = path } + return $ st { indexState = ist } + else do + drawString $ normalizeLen (screenColumns st) str + return st st <- get let limit = if statusBar st then (screenRows st) - 1 else screenRows st @@ -121,31 +124,6 @@ clearMain rows columns = do else return () -- | Helper function of drawMode -drawIndexHelper [] = resetCurrentRow -drawIndexHelper ((path, str):ms) = do - st <- get - (=<<) put $ liftUpdate $ do - moveCursor (curRowAsInteger st) (colPadAsInteger st) - if (selectedRow st == currentRow st) - then do - setColor $ selectionColorID . colorStyle $ st - drawString str - setColor $ baseColorID . colorStyle $ st - let indexState' = (indexState st) { selectedEmailPath = path } - return $ st { indexState = indexState' } - else do - drawString str - return st - - st <- get - let limit = if statusBar st then (screenRows st) - 1 else screenRows st - if currentRow st < limit - then do - incrementCurrentRow - drawIndexHelper ms - else resetCurrentRow - --- | Helper function of drawMode -- TODO: Make helpers functions to draw header and body in a separate way. drawEmailHelper = do st <- get @@ -33,7 +33,7 @@ data LazymailState = LazymailState { data MaildirState = MaildirState { selectedRowMD :: Int , selectedMD :: String - , detectedMDs :: [String] + , detectedMDs :: [(FilePath, String)] } data IndexState = IndexState { |