Fix problem with multi-lines subjects

3 files changed, 20 insertions, 13 deletions

diff --git a/Handlers.hs b/Handlers.hs
index 72f09dc..4a0ba88 100644
--- a/Handlers.hs
+++ b/Handlers.hs
@@ -7,6 +7,7 @@
 
 module Handlers where
 
+import Data.List(intercalate)
 import Control.Monad.State
 import Data.List(stripPrefix)
 import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator)
@@ -151,10 +152,10 @@ formatIndexModeRows st = mapM formatRow where
     msg <- UTF8.readFile fp
     let email = parseEmail msg
     let fs = getFields email
-    let str = normalizeLen (screenColumns st) . concat $
-              [ (ppSep ++) $ ppFlags . getFlags $ fp
-              , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs
-              , (ppSep ++) $ ppIndexSubject . getSubject $ fs
+    let str = normalizeLen (screenColumns st) $ intercalate ppSep $
+              [ ppFlags . getFlags $ fp
+              , ppIndexNameAddr . getFrom $ fs
+              , ppSubject . getSubject $ fs
               ]
     return (fp, str)
 
diff --git a/Print.hs b/Print.hs
index 4b62619..1e46c00 100644
--- a/Print.hs
+++ b/Print.hs
@@ -8,24 +8,29 @@
 
 module Print where
 
+import Data.Char (isSpace)
+import Data.List (intercalate)
 import Network.Email.Mailbox(Flag(..), Flags)
 import Text.ParserCombinators.Parsec.Rfc2822(NameAddr(..))
-import Data.Char ( isSpace )
 
 import Email
 import Rfc1342
 
 nameLen = 20
-ppNameAddr nas = concat $ map ppNameAddr' nas
+ppNameAddr nas = intercalate ", " $ map ppNameAddr' nas
   where ppNameAddr' na = case nameAddr_name na of
                            Nothing -> nameAddr_addr na
-                           Just n  -> decodeField n
+                           Just n  -> (decodeField n) ++ " <" ++ nameAddr_addr na ++ ">"
 
-ppIndexNameAddr = normalizeLen nameLen . ppNameAddr
+ppIndexNameAddr nas = normalizeLen nameLen $ concat $ map ppNameAddr' nas
+  where ppNameAddr' na = case nameAddr_name na of
+                           Nothing -> nameAddr_addr na
+                           Just n  -> (decodeField n)
 
 subjectLen = 90
-ppSubject = decodeField
-ppIndexSubject = normalizeLen subjectLen . ppSubject
+ppSubject = flat . decodeField
+
+flat xs = intercalate " " $ map (dropWhile isSpace) $ map (filter (/= '\r')) $ lines xs
 
 ppFlags :: Flags -> String
 ppFlags = map ppFlag
diff --git a/Screen.hs b/Screen.hs
index 52cdfe2..4e16b22 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -152,11 +152,11 @@ drawEmailHeader = do
     let row = curRowAsInteger st
     setColor $ headerColorID . colorStyle $ st
     moveCursor row (colPadAsInteger st)
-    drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs
+    drawCroppedString st $ ("From: " ++) $ ppNameAddr . getFrom $ fs
     moveCursor (row + 1) (colPadAsInteger st)
-    drawString $ ("To: " ++) $ cropWith "To: " . ppNameAddr . getTo $ fs
+    drawCroppedString st $ ("To: " ++) $ ppNameAddr . getTo $ fs
     moveCursor (row + 2) (colPadAsInteger st)
-    drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs
+    drawCroppedString st $ ("Subject: " ++) $ ppSubject . getSubject $ fs
     setColor $ baseColorID . colorStyle $ st
   put $ st { currentRow = (4 + currentRow st) }
 
@@ -235,6 +235,7 @@ resetScrollBuffer = do
             scrollBufferIn = EH.scrollCrop 0 (screenRows st) $ selectedEmails . indexState $ st }
       put st { indexState = ist }
 
+drawCroppedString st str = drawString $ normalizeLen (screenColumns st) str
 
 -- The type system complains if I want to use the same function for diferents monads
 liftCurses = lift . lift