aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Lazymail/Config.hs2
-rw-r--r--src/Lazymail/Handlers.hs143
-rw-r--r--src/Lazymail/Keymap.hs16
-rw-r--r--src/Lazymail/Print.hs25
-rw-r--r--src/Lazymail/Screen.hs93
-rw-r--r--src/Lazymail/State.hs21
-rw-r--r--src/Lazymail/Types.hs23
-rw-r--r--src/Lazymail/Utils.hs56
8 files changed, 352 insertions, 27 deletions
diff --git a/src/Lazymail/Config.hs b/src/Lazymail/Config.hs
index bfe2333..5769d8e 100644
--- a/src/Lazymail/Config.hs
+++ b/src/Lazymail/Config.hs
@@ -31,6 +31,8 @@ defaultConfig = LazymailConfig {
, indexModeKeymap = defaultIndexKeymap
, emailModeKeymap = defaultEmailKeymap
, composeModeKeymap = defaultComposeKeymap
+ , textEditor = "editor"
+ , sendmailCommand = ["msmtp", "--read-envelope-from", "-t"]
}
--
diff --git a/src/Lazymail/Handlers.hs b/src/Lazymail/Handlers.hs
index c63d6fc..dc1d389 100644
--- a/src/Lazymail/Handlers.hs
+++ b/src/Lazymail/Handlers.hs
@@ -9,20 +9,27 @@ module Lazymail.Handlers where
import Codec.MIME.Parse(parseMIMEMessage)
import Codec.MIME.Type(MIMEValue(..))
-import Control.Exception(evaluate)
+import Control.Monad.Reader
import Control.Monad.State
import Data.List(intercalate, stripPrefix, sort)
-import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator)
-import System.IO(openFile, IOMode(..), hClose)
+import System.Directory(getTemporaryDirectory)
+import System.Exit(ExitCode(..))
+import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator, (</>))
+import System.IO(openFile, IOMode(..), hClose, hSeek, SeekMode(..), hPutStrLn)
import System.Locale(rfc822DateFormat)
+import System.Process(runProcess, waitForProcess)
+import System.Random(randomR, getStdGen, setStdGen)
import Data.DateTime(parseDateTime, startOfTime, formatDateTime)
import qualified System.IO.UTF8 as UTF8
+import qualified System.IO.Strict as Strict
+import UI.NCurses(setEcho)
import Lazymail.Email(lookupField, getBody, formatBody)
import Lazymail.Maildir
import Lazymail.Print
import Lazymail.State
import Lazymail.Types
+import Lazymail.Utils(drawNotification)
previousMode :: LazymailCurses ()
previousMode = get >>= \st -> previousMode' (mode st)
@@ -40,6 +47,8 @@ previousMode' IndexMode = do
let ist = (indexState st) { selectedRowIn = 0, scrollRowIn = 0 }
put $ st { mode = MaildirMode, indexState = ist }
+previousMode' _ = get >>= \st -> put $ st { mode = MaildirMode}
+
advanceMode :: LazymailCurses ()
advanceMode = get >>= \st -> advanceMode' (mode st)
@@ -86,6 +95,9 @@ advanceMode' MaildirMode = do
advanceMode' _ = return ()
+toComposeMode :: LazymailCurses ()
+toComposeMode = get >>= \st -> put $ st { mode = ComposeMode }
+
freeOldHandlers st = mapM (hClose . emailHandle) $ selectedEmails . indexState $ st
scrollDown :: LazymailCurses ()
@@ -138,7 +150,7 @@ scrollDown' EmailMode = do
when ((totalRows - scrRows + (bodyStartRow est) - 1) > (scrollRowEm est)) $
put $ st { emailState = est' }
-scrollDown' _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
+scrollDown' _ = return ()
scrollUp :: LazymailCurses ()
scrollUp = get >>= \st -> scrollUp' (mode st)
@@ -185,7 +197,7 @@ scrollUp' EmailMode = do
when (cur > 0) $
put $ st { emailState = est' }
-scrollUp' _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
+scrollUp' _ = return ()
incrementSelectedRow st | (selectedRow st) < limit =
case (mode st) of
@@ -286,3 +298,124 @@ solveMaildirUpdate = do
let mst = maildirState st
put $ st { maildirState = (mst { triggerUpdateMD = False }) }
+getField :: Maybe String -> LazymailCurses () -> LazymailCurses ()
+getField pr postActions = do
+ st <- get
+ let is = initialInputState { inputRequested = True
+ , prompt = pr
+ , postInputActions = postActions}
+ put $ st { inputState = is }
+
+updateField :: (ComposeFields -> String -> ComposeFields) -> LazymailCurses ()
+updateField f = do
+ st <- get
+ let value = currentInput . inputState $ st
+ let cf = (composeFields . composeState $ st)
+ let cs = (composeState st) { composeFields = (f cf value) }
+ put $ st { inputState = initialInputState
+ , composeState = cs
+ }
+
+getFrom :: LazymailCurses ()
+getFrom = let postActions = updateField $ \cf val -> cf { fromField = Just val }
+ in getField (Just "From: ") postActions
+
+getTo :: LazymailCurses ()
+getTo = let postActions = updateField $ \cf val -> cf { toField = Just val }
+ in getField (Just "To: ") postActions
+
+getSubject :: LazymailCurses ()
+getSubject = let postActions = updateField $ \cf val -> cf { subjectField = Just val }
+ in getField (Just "Subject: ") postActions
+
+getCc :: LazymailCurses ()
+getCc = let postActions = updateField $ \cf val -> cf { ccField = Just val }
+ in getField (Just "Cc: ") postActions
+
+getBcc :: LazymailCurses ()
+getBcc = let postActions = updateField $ \cf val -> cf { bccField = Just val }
+ in getField (Just "Bcc: ") postActions
+
+getReplyTo :: LazymailCurses ()
+getReplyTo = let postActions = updateField $ \cf val -> cf { replyToField = Just val }
+ in getField (Just "Reply-To: ") postActions
+
+editEmail :: LazymailCurses ()
+editEmail = do
+ st <- get
+ cfg <- ask
+ fp <- getFileName
+ exitStatus <- liftIO $ do
+ child <- runProcess (textEditor cfg) [fp] Nothing Nothing Nothing Nothing Nothing
+ waitForProcess child
+ case exitStatus of
+ ExitSuccess -> do
+ st <- get
+ let cs = (composeState st) { bodyReady = True }
+ put $ st { composeState = cs }
+ _ -> drawNotification "The text editor exited abnormally"
+
+-- | Retrieve current file name. Create a randomized one if its's Nothing.
+getFileName :: LazymailCurses FilePath
+getFileName = do
+ st <- get
+ let cs = composeState st
+ case bodyFileName cs of
+ Just fp -> return fp
+ Nothing -> do
+ fp <- liftIO $ newFilename
+ let cs = (composeState st) { bodyFileName = Just fp }
+ put $ st { composeState = cs }
+ return fp
+
+ where
+ newFilename = do
+ tmp <- getTemporaryDirectory
+ num <- getRandomNumber
+ return $ (tmp </>) $ ("lazymail-" ++ ) $ show num
+
+getRandomNumber :: IO Int
+getRandomNumber = do
+ r1 <- getStdGen
+ let (num, r2) = randomR (100000,999999) r1
+ setStdGen r2
+ return num
+
+sendEmail :: LazymailCurses ()
+sendEmail = do
+ st <- get
+ cfg <- ask
+ let cs = composeState st
+ if not . readyToSend $ cs
+ then drawNotification $
+ "The email is not ready to be sent. Please check that all fields are correct."
+ else do
+ exitStatus <- liftIO $ do
+ emailHandle <- prepareEmail cs
+ child <- runProcess (head . sendmailCommand $ cfg)
+ (tail . sendmailCommand $ cfg)
+ Nothing Nothing (Just emailHandle) Nothing Nothing
+ e <- waitForProcess child
+ hClose emailHandle
+ return e
+ handleExitStatus exitStatus
+
+ where
+ handleExitStatus ExitSuccess = do
+ drawNotification $ "The email was successfully sent."
+ st <- get
+ put $ st { mode = MaildirMode, composeState = initialComposeState }
+ handleExitStatus _ = drawNotification $
+ "Could not send the email. Please, check the logs of for your SMTP client."
+ prepareEmail cs = do
+ let fs = composeFields cs
+ let fileName = (maybe "" id $ bodyFileName cs)
+ body <- (Strict.hGetContents =<< openFile fileName ReadMode)
+ emailHandle <- openFile fileName WriteMode
+ hPutStrLn emailHandle $ (unlines . ppComposeFields True $ fs) ++ body
+ hClose emailHandle >> openFile fileName ReadMode
+
+readyToSend cs =
+ let from = maybe False (\_ -> True) $ fromField . composeFields $ cs
+ to = maybe False (\_ -> True) $ toField . composeFields $ cs
+ in all id [from, to, bodyReady cs]
diff --git a/src/Lazymail/Keymap.hs b/src/Lazymail/Keymap.hs
index cdd57cc..9bb2aaa 100644
--- a/src/Lazymail/Keymap.hs
+++ b/src/Lazymail/Keymap.hs
@@ -17,17 +17,29 @@ module Lazymail.Keymap
import UI.NCurses(Event(..), Key(..))
import Lazymail.Types(Keymap, LazymailState(..), Mode(..), LazymailConfig(..))
-import Lazymail.Handlers(advanceMode, previousMode, scrollUp, scrollDown)
+import Lazymail.Handlers( advanceMode, previousMode, scrollUp, scrollDown
+ , toComposeMode, getFrom, getTo, getSubject, getCc
+ , getBcc, getReplyTo, editEmail, sendEmail
+ )
defaultGlobalKeymap = [ ([EventCharacter '\n', EventCharacter ' ', EventSpecialKey KeyRightArrow], advanceMode)
, ([EventCharacter 'q', EventCharacter 'Q'], previousMode)
, ([EventSpecialKey KeyUpArrow, EventCharacter 'k'], scrollUp)
, ([EventSpecialKey KeyDownArrow, EventCharacter 'j'], scrollDown)
+ , ([EventCharacter 'm'], toComposeMode)
]
defaultMaildirKeymap = []
defaultIndexKeymap = []
defaultEmailKeymap = []
-defaultComposeKeymap = []
+defaultComposeKeymap = [ ([EventCharacter 'f'], getFrom)
+ , ([EventCharacter 't'], getTo)
+ , ([EventCharacter 's'], getSubject)
+ , ([EventCharacter 'c'], getCc)
+ , ([EventCharacter 'b'], getBcc)
+ , ([EventCharacter 'r'], getReplyTo)
+ , ([EventCharacter 'e'], editEmail)
+ , ([EventCharacter 'y'], sendEmail)
+ ]
-- | Try to find a keymap for the current mode. If nothing is found, then
-- try looking up in the global keymap.
diff --git a/src/Lazymail/Print.hs b/src/Lazymail/Print.hs
index 15e9df1..a6a38d1 100644
--- a/src/Lazymail/Print.hs
+++ b/src/Lazymail/Print.hs
@@ -13,7 +13,7 @@ import Data.List (intercalate)
import Lazymail.Email
import Codec.Text.Rfc1342
-import Lazymail.Types(Flag(..), Flags)
+import Lazymail.Types(Flag(..), Flags, ComposeFields(..), ComposeState(..))
unquote xs= if (head xs == '"' && last xs == '"') then (tail . init) xs else xs
@@ -43,18 +43,29 @@ ppFlag FORWARDED = 'P'
ppFlag DELETED = 'T'
ppFlag (OTHERFLAG [c]) = c
+ppComposeState cs = ppComposeFields False (composeFields cs) ++
+ [("Body file name: " ++) $ maybe "-" id $ bodyFileName cs]
+
+ppComposeFields removeEmpty cf | removeEmpty == False = l
+ | otherwise = filter (\str -> (last str) /= '-') l
+ where l = [ ("From: " ++) $ maybe "-" id $ fromField cf
+ , ("To: " ++) $ maybe "-" id $ toField cf
+ , ("Cc: " ++) $ maybe "-" id $ ccField cf
+ , ("Bcc: " ++) $ maybe "-" id $ bccField cf
+ , ("Reply-To: " ++) $ maybe "-" id $ replyToField cf
+ , ("Subject: " ++) $ maybe "-" id $ subjectField cf
+ ]
+
ppSep = " "
-normalizeLen len cs = if (length cs > len)
- then shorten len cs
- else if (length cs < len)
- then fillWithSpace len cs
- else cs
+normalizeLen len cs | (length cs > len) = shorten len cs
+ | otherwise = if (length cs < len)
+ then fillWithSpace len cs
+ else cs
fillWithSpace len cs = cs ++ (take (len - length cs) . repeat $ ' ')
-- The following functions are from DynamicLog xmonad-contrib source
-
-- | Wrap a string in delimiters, unless it is empty.
wrap :: String -- ^ left delimiter
-> String -- ^ right delimiter
diff --git a/src/Lazymail/Screen.hs b/src/Lazymail/Screen.hs
index ba64cee..a25c880 100644
--- a/src/Lazymail/Screen.hs
+++ b/src/Lazymail/Screen.hs
@@ -9,12 +9,12 @@
module Lazymail.Screen where
-import Codec.MIME.Type(MIMEValue(..))
-import Control.Monad.Trans(liftIO)
+import Codec.MIME.Type ( MIMEValue(..) )
+import Control.Monad.Trans ( liftIO )
import Control.Monad.Reader
import Control.Monad.State
-import Data.Char(toUpper)
-import Data.List(isPrefixOf)
+import Data.Char ( toUpper, isPrint )
+import Data.List ( isPrefixOf )
import System.Exit
import UI.NCurses
@@ -22,12 +22,15 @@ import UI.NCurses
import Codec.Text.Rfc1342
import Lazymail.Config
import qualified Lazymail.Handlers as EH
-import Lazymail.Keymap(findHandler)
+import Lazymail.Keymap ( findHandler )
import Lazymail.Maildir
-import Lazymail.Email(lookupField, getBody, getHeaders, lookupField')
+import Lazymail.Email ( lookupField, getBody, getHeaders, lookupField' )
import Lazymail.Print
import Lazymail.State
import Lazymail.Types
+import Lazymail.Utils ( newDialogWindow, liftCurses
+ , drawCroppedString, drawNotification
+ )
{- This function is the nexus between Curses and IO -}
entryPoint :: Lazymail ()
@@ -73,7 +76,9 @@ screenLoop = do
get >>= \st ->
(liftCurses . (updateWindow w) $ runStateT (runReaderT performUpdate cfg) st) >>= put . snd
liftCurses $ render
- handleEvent
+ st <- get
+ if (inputRequested . inputState $ st)
+ then handleInputRequest else handleEvent
get >>= \st -> if (not . exitRequested) st
then screenLoop
else return ()
@@ -92,6 +97,7 @@ drawMode :: Mode -> LazymailUpdate ()
drawMode MaildirMode = get >>= \st -> drawSelectionList $ scrollBufferMD . maildirState $ st
drawMode IndexMode = get >>= \st -> drawSelectionList $ scrollBufferIn . indexState $ st
drawMode EmailMode = drawEmailHelper
+drawMode ComposeMode = drawComposeModeHelper
{- Draw a scrollable selection list -}
drawSelectionList [] = resetCurrentRow
@@ -194,6 +200,24 @@ drawBody row col maxRows (xs:xss) = do
drawString xs
when (row < maxRows) $ drawBody (row + 1) col maxRows xss
+{- Draw the current Compose mode fields -}
+drawComposeModeHelper = do
+ st <- get
+ let cs = composeState st
+ let row = curRowAsInteger st
+ let col = colPadAsInteger st
+ let maxRows = if statusBar st then (scrRowsAsInteger st) - 1 else scrRowsAsInteger st
+ liftUpdate $ do
+ drawComposeModeFields st row col maxRows $ ppComposeState cs
+ moveCursor (maxRows - 1) col
+
+ where
+ drawComposeModeFields _ _ _ _ [] = return ()
+ drawComposeModeFields st row col maxRows (f:fs) = do
+ moveCursor row col
+ drawCroppedString st f
+ when (row < maxRows) $ drawComposeModeFields st (row + 1) col maxRows fs
+
{- Draw a status line with the current mode and other stuff -}
drawStatus = do
st <- get
@@ -218,6 +242,9 @@ drawStatusHelper IndexMode st =
{- Status bar string for Email mode -}
drawStatusHelper EmailMode st = ["mode: Email"]
+{- Status bar string for Compose mode -}
+drawStatusHelper ComposeMode st = ["mode: Compose"]
+
{- Handle an event -}
handleEvent :: LazymailCurses ()
handleEvent = loop where
@@ -252,8 +279,52 @@ resetScrollBuffer = do
scrollBufferIn = EH.formatIndexModeRows st $ 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
liftUpdate = lift . lift
+
+-- Input handling functions --
+handleInputRequest :: LazymailCurses ()
+handleInputRequest = do
+ st <- get
+ let is = inputState st
+ (_, cols, w) <- liftCurses $ newDialogWindow st
+ getLineFromWindow w $ fromIntegral cols
+ liftCurses $ closeWindow w
+
+getLineFromWindow :: Window -> Int -> LazymailCurses ()
+getLineFromWindow w cols = do
+ st <- get
+ let is = inputState st
+ liftCurses $ do
+ updateWindow w $ do
+ cleanLine
+ moveCursor 1 1
+ drawString $ (maybe "" id $ prompt is) ++ (currentInput is)
+ render
+ loopForEvents w
+ st <- get
+ when (inputRequested . inputState $ st) $ getLineFromWindow w cols
+
+ where
+ cleanLine = moveCursor 1 1 >> (drawString $ replicate (cols - 2) ' ')
+
+ loopForEvents w = do
+ st <- get
+ let is = inputState st
+ let ci = currentInput is
+ let pr = maybe "" id $ prompt is
+ ev <- liftCurses $ getEvent w Nothing
+ case ev of
+ Nothing -> loopForEvents w
+ Just ev' -> case ev' of
+ EventCharacter '\n' -> do
+ postInputActions is
+ st' <- get
+ put $ st' { inputState = (is { inputRequested = False}) }
+ EventCharacter c | isPrint c -> do
+ let ci' = if length ci == cols - (length pr) - 2 then ci else ci ++ [c]
+ put $ st { inputState = (is { currentInput = ci' }) }
+ EventSpecialKey KeyBackspace -> do
+ let ci' = if null ci then ci else init ci
+ put $ st { inputState = (is { currentInput = ci' } ) }
+ _ -> loopForEvents w
+
diff --git a/src/Lazymail/State.hs b/src/Lazymail/State.hs
index 1323118..bf1e3c2 100644
--- a/src/Lazymail/State.hs
+++ b/src/Lazymail/State.hs
@@ -29,6 +29,7 @@ initialState = LazymailState {
, indexState = initialIndexState
, composeState = initialComposeState
, emailState = initialEmailState
+ , inputState = initialInputState
, colorStyle = initialColorStyle
}
@@ -59,7 +60,18 @@ initialEmailState = EmailState {
}
initialComposeState = ComposeState {
- composition = Nothing
+ composeFields = initialComposeFields
+ , bodyFileName = Nothing
+ , bodyReady = False
+}
+
+initialComposeFields = ComposeFields {
+ fromField = Nothing
+ , toField = Nothing
+ , ccField = Nothing
+ , bccField = Nothing
+ , subjectField = Nothing
+ , replyToField = Nothing
}
initialColorStyle = ColorStyle {
@@ -70,6 +82,13 @@ initialColorStyle = ColorStyle {
, newEmailColorID = defaultColorID
}
+initialInputState = InputState {
+ inputRequested = False
+ , prompt = Nothing
+ , currentInput = ""
+ , postInputActions = return ()
+}
+
scrColsAsInteger st = toInteger $ screenColumns st
scrRowsAsInteger st = toInteger $ screenRows st
curRowAsInteger st = toInteger $ currentRow st
diff --git a/src/Lazymail/Types.hs b/src/Lazymail/Types.hs
index ce46f65..6ef4f5b 100644
--- a/src/Lazymail/Types.hs
+++ b/src/Lazymail/Types.hs
@@ -39,6 +39,8 @@ data LazymailConfig = LazymailConfig {
, indexModeKeymap :: [Keymap]
, emailModeKeymap :: [Keymap]
, composeModeKeymap :: [Keymap]
+ , textEditor :: FilePath
+ , sendmailCommand :: [String]
}
data Email = Email {
@@ -84,6 +86,7 @@ data LazymailState = LazymailState {
, indexState :: IndexState
, emailState :: EmailState
, composeState :: ComposeState
+ , inputState :: InputState
, colorStyle :: ColorStyle
}
@@ -107,9 +110,20 @@ data IndexState = IndexState {
}
data ComposeState = ComposeState {
- composition :: Maybe String
+ composeFields :: ComposeFields
+ , bodyFileName :: Maybe FilePath
+ , bodyReady :: Bool
}
+data ComposeFields = ComposeFields {
+ fromField :: Maybe String
+ , toField :: Maybe String
+ , ccField :: Maybe String
+ , bccField :: Maybe String
+ , subjectField :: Maybe String
+ , replyToField :: Maybe String
+}
+
data EmailState = EmailState {
scrollRowEm :: Int
, bodyStartRow :: Int
@@ -125,4 +139,11 @@ data ColorStyle = ColorStyle {
, newEmailColorID :: ColorID
}
+data InputState = InputState {
+ inputRequested :: Bool
+ , prompt :: Maybe String
+ , currentInput :: String
+ , postInputActions :: LazymailCurses ()
+}
+
type Keymap = ([Event], LazymailCurses ()) \ No newline at end of file
diff --git a/src/Lazymail/Utils.hs b/src/Lazymail/Utils.hs
new file mode 100644
index 0000000..a31db63
--- /dev/null
+++ b/src/Lazymail/Utils.hs
@@ -0,0 +1,56 @@
+{- Miscellaneous functions written apart in order to avoid
+ - cyclics module imports
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -}
+
+module Lazymail.Utils ( newDialogWindow, drawNotification
+ , liftCurses, drawCroppedString
+ ) where
+
+import Control.Monad.Trans ( liftIO )
+import Control.Monad.Reader
+import Control.Monad.State
+import UI.NCurses
+
+import Lazymail.Print
+import Lazymail.Types
+import Lazymail.State
+
+newDialogWindow :: LazymailState -> Curses (Integer, Integer, Window)
+newDialogWindow st =
+ let rows = 3
+ cols st = 9 * ((scrColsAsInteger st) `div` 10)
+ startCol st = 2 * ((scrColsAsInteger st) `div` 20)
+ startRow st = (div (scrRowsAsInteger st) 2) - 1
+ in do
+ w <- newWindow 3 (cols st) (startRow st) (startCol st)
+ updateWindow w $ drawBox Nothing Nothing
+ render
+ return (rows, cols st, w)
+
+drawNotification :: String -> LazymailCurses ()
+drawNotification errorMessage = do
+ st <- get
+ (_, cols, w) <- liftCurses $ newDialogWindow st
+ liftCurses $ do
+ updateWindow w $ do
+ moveCursor 1 1
+ drawString errorMessage
+ render
+ waitFor w (\ev -> ev == EventCharacter 'q' || ev == EventCharacter 'Q' || ev == EventCharacter '\n')
+ closeWindow w
+
+waitFor :: Window -> (Event -> Bool) -> Curses ()
+waitFor w p = loop where
+ loop = do
+ ev <- getEvent w Nothing
+ case ev of
+ Nothing -> loop
+ Just ev' -> if p ev' then return () else loop
+
+liftCurses = lift . lift
+
+drawCroppedString st str = drawString $ normalizeLen (screenColumns st) str
nihil fit ex nihilo