diff options
author | Raúl Benencia <rul@kalgan.cc> | 2013-08-27 15:03:04 -0300 |
---|---|---|
committer | Raúl Benencia <rul@kalgan.cc> | 2013-08-27 15:03:04 -0300 |
commit | fab15274bae93611f85dd4cc221ce07b1661a081 (patch) | |
tree | 1023af4c4b664ade52466babadf3dc95864aab1e /Handlers.hs | |
parent | f21a1f23ab53ab628ed2677c8d85869fa7e22b45 (diff) |
Smoother scrolling in index mode
Diffstat (limited to 'Handlers.hs')
-rw-r--r-- | Handlers.hs | 48 |
1 files changed, 41 insertions, 7 deletions
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) |