Towards email scrolling

3 files changed, 50 insertions, 14 deletions

diff --git a/Email.hs b/Email.hs
index 40d1c4c..2281703 100644
--- a/Email.hs
+++ b/Email.hs
@@ -18,7 +18,7 @@ data Email = Email { emailPath :: String
                    }
 
 parseEmail :: String -> Message
-parseEmail msg = unwrapEmail $ parse message "<stdin>" $  fixEol msg
+parseEmail msg = unwrapEmail $ parse message "<stdin>" $  fixEol $ uglyWorkaround msg
 
 unwrapEmail (Right email) = email
 getFields (Message fs _) = fs
@@ -49,6 +49,15 @@ getResentMessageID fs = do { ResentMessageID f <- fs; f }
 getBody (Message _ []) = "Empty body"
 getBody (Message _ body) = body
 
+-- | Convert a String to multiple Strings, cropped by the maximum column
+--   size if necessary.
+formatBody :: String -> Int -> [String]
+formatBody body maxColumns = format [] [] body where
+  format parsed acc []                     = parsed ++ [acc]
+  format parsed acc ('\r':'\n':xs) = format (parsed ++ [acc]) [] xs
+  format parsed acc rest@(x:xs) | length acc < maxColumns = format parsed (acc ++ [x]) xs
+                                | otherwise               = format (parsed ++ [acc]) "+" rest
+
 -- Make sure all lines are terminated by CRLF.
 fixEol :: String -> String
 fixEol ('\r':'\n':xs)   = '\r' : '\n' : fixEol xs
@@ -65,4 +74,18 @@ fixEol []               = []
 
 -- emailDescriptionWithPP pp
 
+{- This is an ugly, Ugly, UGLY workaround for the encoding problems that I
+ - have with Rfc2822 module. I've reported the bug. I hope it get fixed any time soon so
+ - I can kill this function with fire -}
 
+uglyWorkaround :: String -> String
+uglyWorkaround = map replace where
+  replace c =
+    case c of
+      'á' -> 'a'
+      'é' -> 'e'
+      'í' -> 'i'
+      'ó' -> 'o'
+      'ú' -> 'u'
+      'ñ' -> 'n'
+      _   -> c
diff --git a/Screen.hs b/Screen.hs
index 8383fe2..c2da7ac 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -58,7 +58,7 @@ startCurses = do
     return $ st { screenRows = fromIntegral $ rows - 1
                 , screenColumns = fromIntegral $ cols
                 , colorStyle = style }
-      
+
   resetScrollBuffer
   screenLoop
 
@@ -140,8 +140,8 @@ drawEmailHelper = do
   let body = getBody $ selectedEmail . indexState $ st
   let maxRows = if statusBar st then (scrRowsAsInteger st) - 1 else scrRowsAsInteger st
   let emailLines = formatBody body $ (screenColumns st) - 1
-  drawBody ((curRowAsInteger st) + 4) (colPadAsInteger st) maxRows emailLines
-          
+  liftUpdate $ drawBody ((curRowAsInteger st) + 4) (colPadAsInteger st) maxRows emailLines
+
 {- Draw the email headers -}
 drawEmailHeader = do
   st <- get
@@ -157,13 +157,13 @@ drawEmailHeader = do
     moveCursor (row + 2) (colPadAsInteger st)
     drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs
     setColor $ baseColorID . colorStyle $ st
-  
-{- Draw the email body -}  
+
+{- Draw the email body -}
 drawBody _ _ _ [] = return ()
-drawBody row col maxRows (xs:xss) = liftUpdate $ do
+drawBody row col maxRows (xs:xss) = do
   moveCursor row col
   drawString xs
-  if row <  maxRows then drawBody (row + 1) col maxRows  xss else return ()
+  when (row <  maxRows) $ drawBody (row + 1) col maxRows  xss
 
 {- Draw a status line with the current mode and other stuff -}
 drawStatus  = do
@@ -227,11 +227,11 @@ resetScrollBuffer = do
     MaildirMode -> do
       let mst = (maildirState st) {
             scrollBufferMD = EH.scrollCrop 0 (screenRows st) $ detectedMDs . maildirState $ st }
-      put st { maildirState = mst}    
+      put st { maildirState = mst}
     IndexMode -> do
       let ist = (indexState st) {
             scrollBufferIn = EH.scrollCrop 0 (screenRows st) $ selectedEmails . indexState $ st }
-      put st { indexState = ist }    
+      put st { indexState = ist }
 
 
 -- The type system complains if I want to use the same function for diferents monads
diff --git a/State.hs b/State.hs
index 80d562a..e7f551e 100644
--- a/State.hs
+++ b/State.hs
@@ -26,6 +26,7 @@ data LazymailState = LazymailState {
   , statusBar       :: Bool
   , maildirState    :: MaildirState
   , indexState      :: IndexState
+  , emailState      :: EmailState
   , composeState    :: ComposeState
   , colorStyle      :: ColorStyle
 }
@@ -36,7 +37,6 @@ data MaildirState = MaildirState {
   , detectedMDs     :: [(FilePath, String)]
   , scrollRowMD     :: Int
   , scrollBufferMD  :: [(FilePath, String)]
-    
 }
 
 data IndexState = IndexState {
@@ -53,11 +53,17 @@ data ComposeState = ComposeState {
     composition     :: Maybe String
 }
 
+data EmailState = EmailState {
+    scrollBufferEm :: [String]
+  , scrollRowEm    :: Int
+  , emailLines     :: [String]
+}
+
 data ColorStyle = ColorStyle {
     baseColorID      :: ColorID
   , selectionColorID :: ColorID
   , statusBarColorID :: ColorID
-  , headerColorID    :: ColorID    
+  , headerColorID    :: ColorID
 }
 
 initialState = LazymailState {
@@ -72,6 +78,7 @@ initialState = LazymailState {
   , maildirState  = initialMaildirState
   , indexState    = initialIndexState
   , composeState  = initialComposeState
+  , emailState    = initialEmailState
   , colorStyle    = initialColorStyle
 }
 
@@ -93,6 +100,12 @@ initialIndexState = IndexState {
   , scrollBufferIn     = []
 }
 
+initialEmailState = EmailState {
+    scrollBufferEm = []
+  , scrollRowEm    = 0
+  , emailLines     = []
+}
+
 initialComposeState = ComposeState {
     composition = Nothing
 }
@@ -101,7 +114,7 @@ initialColorStyle = ColorStyle {
     baseColorID      = defaultColorID
   , selectionColorID = defaultColorID
   , statusBarColorID = defaultColorID
-  , headerColorID    = defaultColorID                       
+  , headerColorID    = defaultColorID
 }
 
 scrColsAsInteger st = toInteger $ screenColumns st
@@ -132,7 +145,7 @@ incrementSelectedRow st | (selectedRow st) < limit =
     curMDLen = length $ detectedMDs . maildirState $ st
     limit' = case (mode st) of
       MaildirMode -> if curMDLen < scrRows then curMDLen - 1 else scrRows
-      IndexMode   -> if curInLen < scrRows then curInLen - 1 else scrRows     
+      IndexMode   -> if curInLen < scrRows then curInLen - 1 else scrRows
     limit = if (statusBar st) && (limit' == scrRows)
             then fromIntegral $ limit' - 2
             else fromIntegral limit'