Smoother scrolling in index mode

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'