From fab15274bae93611f85dd4cc221ce07b1661a081 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ra=C3=BAl=20Benencia?= Date: Tue, 27 Aug 2013 15:03:04 -0300 Subject: Smoother scrolling in index mode --- Config.hs | 4 ++-- Handlers.hs | 48 +++++++++++++++++++++++++++++++++++++++++------- Maildir.hs | 8 ++++++-- Screen.hs | 18 ++++-------------- State.hs | 33 +++++++++++++++++++-------------- 5 files changed, 72 insertions(+), 39 deletions(-) diff --git a/Config.hs b/Config.hs index 34bd509..39f4371 100644 --- a/Config.hs +++ b/Config.hs @@ -25,8 +25,8 @@ data LazymailConfig = LazymailConfig { defaultConfig = LazymailConfig { baseColor = (ColorWhite, ColorBlack) - , selectionColor = (ColorBlack, ColorWhite) - , statusBarColor = (ColorBlack, ColorWhite) + , selectionColor = (ColorYellow, ColorBlack) + , statusBarColor = (ColorYellow, ColorBlack) , showStatusBar = True , initialPath = "" , filterMaildirsHook = \mds -> return mds diff --git a/Handlers.hs b/Handlers.hs index 566fca9..9777b3c 100644 --- a/Handlers.hs +++ b/Handlers.hs @@ -9,8 +9,11 @@ module Handlers where import Control.Monad.State +import Email(parseEmail, getFields, getSubject, getFrom) import Maildir +import Print import State +import System.IO(IOMode(..), hGetContents, openFile) import Types (LazymailCurses) previousMode :: Mode -> LazymailCurses () @@ -18,13 +21,20 @@ previousMode IndexMode = (=<<) put $ get >>= \st -> return st { mode = Maildir previousMode EmailMode = (=<<) put $ get >>= \st -> return st { mode = IndexMode } previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True } -changeMode IndexMode = (=<<) put $ get >>= \st -> return st { mode = EmailMode } +changeMode :: Mode -> LazymailCurses () changeMode EmailMode = return () +changeMode IndexMode = do + st <- get + msg <- liftIO $ readFile . selectedEmailPath . indexState $ st + let ist = (indexState st) { selectedEmail = (parseEmail msg) } + put $ st { mode = EmailMode, indexState = ist } + changeMode MaildirMode = do st <- get selectedEmails' <- liftIO $ do let md = (selectedMD . maildirState) $ st - getMaildirEmails md + emails <- getMaildirEmails md + formatIndexModeRows st emails let indexState' = (indexState st) { selectedEmails = selectedEmails' , currentInLen = length selectedEmails' @@ -35,27 +45,51 @@ changeMode MaildirMode = do incSelectedRow IndexMode = do st <- get let inSt = indexState st - if (selectedRowIn inSt) > (div (screenRows st) 2) - then do + let selRow = selectedRowIn inSt + let topScrollRow = scrollRowIn inSt + let startScrolling = (div (screenRows st) 4) * 3 + let totalRows = currentInLen inSt + + if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st))) + then do -- Scroll emails let scrollRowIn' = scrollRowIn inSt + 1 let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } put st { indexState = inSt' } - else put $ incrementSelectedRow st + else -- Move the selected row + put $ incrementSelectedRow st + incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st decSelectedRow IndexMode = do st <- get let inSt = indexState st - if (scrollRowIn inSt) > 0 + let selRow = selectedRowIn inSt + let startScrolling = (div (screenRows st) 4) + let topScrollRow = scrollRowIn inSt + if topScrollRow > 0 && selRow < startScrolling then do let scrollRowIn' = scrollRowIn inSt - 1 let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } put st { indexState = inSt' } - else put $ decrementSelectedRow st + else + put $ decrementSelectedRow st decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st {- Given a list, it returns the elements that will be in the next screen refresh - TODO: find a better name -} scrollCrop top rows xs = take rows $ drop top xs + +formatIndexModeRows st = mapM formatRow where + formatRow fp = do + msg <- hGetContents =<< (openFile fp ReadMode) + let email = parseEmail msg + let fs = getFields email + let str = normalizeLen (screenColumns st) . concat $ + [ show $ (currentRow st) + (scrollRowIn . indexState $ st) + 1 + , (ppSep ++) $ ppFlags . getFlags $ fp + , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs + , (ppSep ++) $ ppIndexSubject . getSubject $ fs + ] + return (fp, str) diff --git a/Maildir.hs b/Maildir.hs index f76695a..ede0f44 100644 --- a/Maildir.hs +++ b/Maildir.hs @@ -29,8 +29,12 @@ getMaildirEmails md = do n <- (getNewEmails md) return $ r ++ n -getReadEmails md = getDirectoryContents $ md "cur" -getNewEmails md = getDirectoryContents $ md "new" +getReadEmails md = getEmails $ md "cur" +getNewEmails md = getEmails $ md "new" + +getEmails fp = do + contents <- getDirectoryContents fp + return $ map (fp ) $ filter (`notElem` [".", ".."]) contents {- | Returns information about specific messages. -} getMessages :: Maildir -> [FilePath] -> IO [(FilePath, Flags, String)] diff --git a/Screen.hs b/Screen.hs index 42f8ac8..189840e 100644 --- a/Screen.hs +++ b/Screen.hs @@ -14,7 +14,6 @@ import Control.Monad.Reader import Control.Monad.State import Data.List(isPrefixOf) import System.Exit -import System.IO(IOMode(..), hGetContents, openFile) import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) import UI.NCurses @@ -123,25 +122,16 @@ clearMain rows columns = do -- | Helper function of drawMode drawIndexHelper [] = resetCurrentRow -drawIndexHelper (m:ms) = do +drawIndexHelper ((path, str):ms) = do st <- get (=<<) put $ liftUpdate $ do - msg <- liftToUpdate $ hGetContents =<< (openFile m ReadMode) moveCursor (curRowAsInteger st) (colPadAsInteger st) - let email = parseEmail msg - let fs = getFields email - let str = normalizeLen (screenColumns st) . concat $ - [ show $ (currentRow st) + (scrollRowIn . indexState $ st) + 1 - , (ppSep ++) $ ppFlags . getFlags $ m - , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs - , (ppSep ++) $ ppIndexSubject . getSubject $ fs - ] if (selectedRow st == currentRow st) then do setColor $ selectionColorID . colorStyle $ st drawString str setColor $ baseColorID . colorStyle $ st - let indexState' = (indexState st) { selectedEmail = email} + let indexState' = (indexState st) { selectedEmailPath = path } return $ st { indexState = indexState' } else do drawString str @@ -239,5 +229,5 @@ incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (cur liftCurses = lift . lift liftUpdate = lift . lift -liftToUpdate :: IO a -> Update a -liftToUpdate io = Update $ lift (liftIO io) \ No newline at end of file +--liftToUpdate :: IO a -> Update a +--liftToUpdate io = Update $ lift (liftIO io) \ No newline at end of file diff --git a/State.hs b/State.hs index 5b91d15..7613cf1 100644 --- a/State.hs +++ b/State.hs @@ -37,12 +37,13 @@ data MaildirState = MaildirState { } data IndexState = IndexState { - selectedRowIn :: Int - , selectedEmail :: Message - , selectedEmails :: [FilePath] - , scrollRowIn :: Int - , currentInLen :: Int - , scrollBufferIn :: [FilePath] + selectedRowIn :: Int + , selectedEmail :: Message + , selectedEmailPath :: FilePath + , selectedEmails :: [(FilePath, String)] + , scrollRowIn :: Int + , currentInLen :: Int + , scrollBufferIn :: [(FilePath, String)] } data ComposeState = ComposeState { @@ -77,12 +78,13 @@ initialMaildirState = MaildirState { } initialIndexState = IndexState { - selectedRowIn = 0 - , selectedEmail = Message [] "Dummy email" - , selectedEmails = [] - , scrollRowIn = 0 - , currentInLen = 0 - , scrollBufferIn = [] + selectedRowIn = 0 + , selectedEmail = Message [] "Dummy email" + , selectedEmailPath = "" + , selectedEmails = [] + , scrollRowIn = 0 + , currentInLen = 0 + , scrollBufferIn = [] } initialComposeState = ComposeState { @@ -118,10 +120,13 @@ incrementSelectedRow st | (selectedRow st) < limit = _ -> st | otherwise = st where + scrRows = screenRows st limit' = case (mode st) of MaildirMode -> (length $ detectedMDs . maildirState $ st ) - 1 - IndexMode -> (length $ selectedEmails . indexState $ st) - 1 - limit = if (statusBar st) && (limit' == screenRows st) + IndexMode -> if (currentInLen . indexState $ st) < scrRows + then (currentInLen . indexState $ st) - 1 + else scrRows + limit = if (statusBar st) && (limit' == scrRows) then fromIntegral $ limit' - 2 else fromIntegral limit' -- cgit v1.2.3