aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRaúl Benencia <rul@kalgan.cc>2013-08-29 23:33:37 -0300
committerRaúl Benencia <rul@kalgan.cc>2013-08-29 23:33:37 -0300
commit96be972c18b9ff389cf713d9cd025fb31bea503f (patch)
treef930c7895778019320c7af890e746cd2ffb807f1
parent6532d2b357160fe6a41ac4ec3aeb1283027d116e (diff)
down-scrolling support in Email mode
-rw-r--r--Handlers.hs14
-rw-r--r--Screen.hs12
-rw-r--r--State.hs8
3 files changed, 22 insertions, 12 deletions
diff --git a/Handlers.hs b/Handlers.hs
index e01d51a..0fc1bd7 100644
--- a/Handlers.hs
+++ b/Handlers.hs
@@ -34,8 +34,7 @@ changeMode IndexMode = do
let email = parseEmail msg
let body = getBody $ email
let el = formatBody body $ screenColumns st
- let sbe = scrollCrop 0 (screenRows st) el
- let est = (emailState st) { currentEmail = email, emailLines = el, scrollBufferEm = sbe }
+ let est = (emailState st) { currentEmail = email, emailLines = el, scrollRowEm = 0 }
put $ st { mode = EmailMode, emailState = est }
changeMode MaildirMode = do
@@ -86,6 +85,17 @@ incSelectedRow MaildirMode = do
else -- Move the selected row
put $ incrementSelectedRow st
+incSelectedRow EmailMode = do
+ st <- get
+ let est = emailState st
+ let cur = scrollRowEm est
+ let scrRows = screenRows st
+ let totalRows = length $ emailLines est
+ let est' = est { scrollRowEm = (cur + 1) }
+
+ when ((totalRows - scrRows) > (scrollRowEm est)) $
+ put $ st { emailState = est' }
+
incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
{- More boilerplate code -}
diff --git a/Screen.hs b/Screen.hs
index 26c5d9b..52cdfe2 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -128,19 +128,20 @@ clearMain rows columns = do
drawEmptyLine currentRow = do
moveCursor currentRow 0
drawString $ replicate (columns) ' '
- if currentRow < rows - 1
- then drawEmptyLine $ currentRow + 1
- else return ()
+ when (currentRow < rows - 1) $ drawEmptyLine $ currentRow + 1
{- Helper function of drawMode -}
drawEmailHelper = do
drawEmailHeader
st <- get
+ let est = emailState st
let body = getBody $ currentEmail . emailState $ st
let maxRows = if statusBar st then (scrRowsAsInteger st) - 1 else scrRowsAsInteger st
- let emailLines = formatBody body $ (screenColumns st) - 1
- liftUpdate $ drawBody ((curRowAsInteger st) + 4) (colPadAsInteger st) maxRows emailLines
+ liftUpdate $
+ drawBody (curRowAsInteger st) (colPadAsInteger st) maxRows $
+ drop (scrollRowEm est) $ emailLines est
+ resetCurrentRow
{- Draw the email headers -}
drawEmailHeader = do
@@ -157,6 +158,7 @@ drawEmailHeader = do
moveCursor (row + 2) (colPadAsInteger st)
drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs
setColor $ baseColorID . colorStyle $ st
+ put $ st { currentRow = (4 + currentRow st) }
{- Draw the email body -}
drawBody _ _ _ [] = return ()
diff --git a/State.hs b/State.hs
index b6561ff..d72bc1a 100644
--- a/State.hs
+++ b/State.hs
@@ -53,10 +53,9 @@ data ComposeState = ComposeState {
}
data EmailState = EmailState {
- scrollBufferEm :: [String]
- , scrollRowEm :: Int
+ scrollRowEm :: Int
, emailLines :: [String]
- , currentEmail :: Message
+ , currentEmail :: Message
}
data ColorStyle = ColorStyle {
@@ -100,8 +99,7 @@ initialIndexState = IndexState {
}
initialEmailState = EmailState {
- scrollBufferEm = []
- , scrollRowEm = 0
+ scrollRowEm = 0
, emailLines = []
, currentEmail = Message [] "Dummy email"
}
nihil fit ex nihilo