diff options
| -rw-r--r-- | Email.hs | 25 | ||||
| -rw-r--r-- | Screen.hs | 18 | ||||
| -rw-r--r-- | State.hs | 21 |
3 files changed, 50 insertions, 14 deletions
@@ -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 @@ -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 @@ -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' |