diff options
Diffstat (limited to 'Screen.hs')
| -rw-r--r-- | Screen.hs | 179 |
1 files changed, 95 insertions, 84 deletions
@@ -14,6 +14,7 @@ import Control.Monad.State import Data.List(isPrefixOf) import UI.NCurses as UI import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) +import System.Exit -- Local imports import Config @@ -49,9 +50,9 @@ startCurses = do basColID <- newColorID (fst . baseColor $ cfg) (snd . baseColor $ cfg) 1 selColID <- newColorID (fst . selectionColor $ cfg) (snd . selectionColor $ cfg) 2 staColID <- newColorID (fst . statusBarColor $ cfg) (snd . statusBarColor $ cfg) 3 - let style = ColorStyle basColID selColID staColID - return $ st { screenRows = fromIntegral rows - , screenColumns = fromIntegral cols + let style = ColorStyle defaultColorID selColID staColID + return $ st { screenRows = fromIntegral $ rows - 1 + , screenColumns = fromIntegral $ cols , colorStyle = style } screenLoop @@ -61,7 +62,8 @@ screenLoop = do w <- liftCurses $ defaultWindow st <- get cfg <- ask - liftCurses $ updateWindow w $ do runStateT (runReaderT performUpdate cfg) st + (_, st') <- liftCurses $ updateWindow w $ runStateT (runReaderT performUpdate cfg) st + put st' liftCurses $ render handleEvent st <- get @@ -69,109 +71,114 @@ screenLoop = do then screenLoop else return () -performUpdate :: LazymailUpdate () +--performUpdate :: LazymailUpdate () performUpdate = do st <- get liftUpdate $ clearMain (scrRowsAsInteger st) (screenColumns st) drawMode (mode st) drawStatus + get >>= return --- | Pattern match on the received mode and draw it in the screen. +{- Pattern match on the received mode and draw it in the screen. -} drawMode :: Mode -> LazymailUpdate () -drawMode MaildirMode = do - st <- get - let mdState = maildirState st - drawMaildirHelper $ detectedMDs mdState ---drawMode EmailMode = drawEmailHelper ---drawMode IndexMode = drawIndexHelper (selectedEmails st) +drawMode MaildirMode = get >>= \st -> drawMaildirHelper $ detectedMDs . maildirState $ st +drawMode IndexMode = get >>= \st -> drawIndexHelper $ selectedEmails . indexState $ st +drawMode EmailMode = drawEmailHelper --- | Helper function of drawMode +{- Helper function of drawMode -} drawMaildirHelper :: [FilePath] -> LazymailUpdate () drawMaildirHelper [] = resetCurrentRow drawMaildirHelper (md:mds) = do st <- get - (=<<) put $ liftUpdate $ do - moveCursor (curRowAsInteger st) (colPadAsInteger st) - if (selectedRow st == currentRow st) + liftUpdate $ moveCursor (curRowAsInteger st) (colPadAsInteger st) + if (selectedRow st == currentRow st) then do - setColor $ selectionColorID . colorStyle $ st - drawString $ normalizeLen (screenColumns st) md - setColor $ baseColorID . colorStyle $ st - let mdState = (maildirState st) { selectedMD = md } - return $ st { maildirState = mdState } - else do - drawString $ normalizeLen (screenColumns st) md - return st + liftUpdate $ do + setColor $ selectionColorID . colorStyle $ st + drawString $ normalizeLen (screenColumns st) md + setColor $ baseColorID . colorStyle $ st + let maildirState' = (maildirState st) { selectedMD = md } + put $ st { maildirState = maildirState' } + else liftUpdate $ drawString $ normalizeLen (screenColumns st) md st <- get let limit = if statusBar st then (screenRows st) - 1 else screenRows st if currentRow st < limit then do - put st { currentRow = (currentRow st) + 1 } + incrementCurrentRow drawMaildirHelper mds else resetCurrentRow --- | Empty the whole window. Useful when changing modes. +{- Empty the whole window. Useful when changing modes. -} clearMain rows columns = do drawEmptyLine 0 where drawEmptyLine currentRow = do moveCursor currentRow 0 - drawString $ replicate (columns - 1) ' ' - if currentRow < (rows - 1) + drawString $ replicate (columns) ' ' + if currentRow < rows - 1 then drawEmptyLine $ currentRow + 1 else return () -{- + -- | Helper function of drawMode -drawIndexHelper st [] = return $ st { curRow = 0 } --moveCursor 0 0 >> return st -drawIndexHelper st ((fp, _, msg):ts) = do - moveCursor (curRow st) (colPadding st) - let email = parseEmail msg - let fs = getFields email - let str = normalizeLen (scrColsAsInt st) . concat $ - [ show $ (curRow st) + 1 - , (ppSep ++) $ ppFlags . getFlags $ fp - , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs - , (ppSep ++) $ ppIndexSubject . getSubject $ fs - ] - st' <- if (selectedRow st == curRow st) - then do - setColor $ selectedColorID st - drawString str - setColor defaultColorID - return $ st { selectedEmail = email } - else do - drawString str - return st - if curRow st' < ((scrRows st') - 1) - then drawIndexHelper (incCurRow st') ts - else return $ st' { curRow = 0 } - +drawIndexHelper [] = resetCurrentRow +drawIndexHelper ((fp, _, msg):ts) = do + st <- get + (=<<) put $ liftUpdate $ do + moveCursor (curRowAsInteger st) (colPadAsInteger st) + let email = parseEmail msg + let fs = getFields email + let str = normalizeLen (screenColumns st) . concat $ + [ show $ (currentRow st) + 1 + , (ppSep ++) $ ppFlags . getFlags $ fp + , (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} + return $ st { indexState = indexState' } + else do + drawString str + return st + + st <- get + let limit = if statusBar st then (screenRows st) - 1 else screenRows st + if currentRow st < limit + then do + incrementCurrentRow + drawIndexHelper ts + else resetCurrentRow + -- | Helper function of drawMode --- TODO: Make helpers functions to draw header and body in a separate way. -drawEmailHelper st = do - let fs = getFields $ selectedEmail st - let cropWith xs = normalizeLen $ (scrColsAsInt st) - (length xs) - let row = curRow st - moveCursor row (colPadding st) - drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs - moveCursor (row + 1) (colPadding st) - drawString $ ("To: " ++) $ cropWith "To: " . ppNameAddr . getTo $ fs - moveCursor (row + 2) (colPadding st) - drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs - - let body = getBody $ selectedEmail st - drawBody (row + 4) (colPadding st) $ formatBody body (scrColsAsInt st) - return st - where drawBody _ _ [] = return () - drawBody row col (xs:xss) = do +-- TODO: Make helpers functions to draw header and body in a separate way. +drawEmailHelper = do + st <- get + let fs = getFields $ selectedEmail . indexState $ st + let cropWith xs = normalizeLen $ (screenColumns st) - (length xs) + let row = curRowAsInteger st + liftUpdate $ do + moveCursor row (colPadAsInteger st) + drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs + moveCursor (row + 1) (colPadAsInteger st) + drawString $ ("To: " ++) $ cropWith "To: " . ppNameAddr . getTo $ fs + moveCursor (row + 2) (colPadAsInteger st) + drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs + + let body = getBody $ selectedEmail . indexState $ st + liftUpdate $ drawBody (row + 4) (colPadAsInteger st) (scrRowsAsInteger st) $ formatBody body (screenColumns st) + + where drawBody _ _ _ [] = return () + drawBody row col maxRows (xs:xss) = do moveCursor row col drawString xs - if row < (scrRows st) then drawBody (row + 1) col xss else return () + if row < maxRows then drawBody (row + 1) col maxRows xss else return () - -- | Convert a String to multiple Strings, cropped by the maximum column -- size if necessary. formatBody :: String -> Int -> [String] @@ -181,12 +188,12 @@ formatBody body maxColumns = format [] [] body where format parsed acc rest@(x:xs) | length acc < maxColumns = format parsed (acc ++ [x]) xs | otherwise = format (parsed ++ [acc]) "+" rest --} + -- | Draw a status line with the current mode and other stuff drawStatus = do st <- get liftUpdate $ do - moveCursor ((scrRowsAsInteger st) - 2) 0 + moveCursor ((scrRowsAsInteger st) - 1) 0 setColor $ statusBarColorID . colorStyle $ st drawString . normalizeLen (screenColumns st) . concat $ drawStatusHelper (mode st) st setColor $ baseColorID . colorStyle $ st @@ -195,9 +202,9 @@ drawStatusHelper MaildirMode st = ["Maildir listing - " , "(", show ((+ 1) . selectedRow $ st), "/" , show (length $ detectedMDs . maildirState $ st), ")"] -drawStatusHelper IndexMode st = ["mode: Index - "] --- , "(", show ((+ 1) . selectedRow $ st), "/" --- , show (length $ selectedEmails . indexState $ st), ")"] +drawStatusHelper IndexMode st = ["mode: Index - " + , "(", show ((+ 1) . selectedRow $ st), "/" + , show (length $ selectedEmails . indexState $ st), ")"] drawStatusHelper EmailMode st = ["mode: Email"] @@ -218,20 +225,24 @@ handleEvent = loop where EmailMode -> put $ st { mode = IndexMode } MaildirMode -> put $ st { exitRequested = True } -{- EventSpecialKey KeyUpArrow -> put $ decSelectedRow st - EventCharacter 'k' -> put $ decSelectedRow st + EventSpecialKey KeyUpArrow -> put $ decrementSelectedRow st + EventCharacter 'k' -> put $ decrementSelectedRow st - EventSpecialKey KeyDownArrow -> put $ incSelectedRow st - EventCharacter 'j' -> put $ incSelectedRow st + EventSpecialKey KeyDownArrow -> put $ incrementSelectedRow st + EventCharacter 'j' -> put $ incrementSelectedRow st EventSpecialKey KeyRightArrow -> do case (mode st) of IndexMode -> put $ st { mode = EmailMode } EmailMode -> return () MaildirMode -> do - selEmails <- liftIO $ getAll . selectedMD $ st - return $ st { mode = IndexMode, selectedEmails = selEmails } -} + selectedEmails' <- liftIO $ do + let md = (selectedMD . maildirState) $ st + getAll md + let indexState' = (indexState st) { selectedEmails = selectedEmails' } + put $ st { mode = IndexMode, indexState = indexState' } _ -> loop -resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
\ No newline at end of file +resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 } +incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 } |