diff options
| -rw-r--r-- | Handlers.hs | 9 | ||||
| -rw-r--r-- | Print.hs | 17 | ||||
| -rw-r--r-- | Screen.hs | 7 |
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) @@ -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 @@ -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 |