Compose mode

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