1. John Lenz
  2. notmuch-web

Commits

John Lenz  committed 12ca350

Add option to control how the body of a composed message is formatted

  • Participants
  • Parent commits 1779bea
  • Branches default

Comments (0)

Files changed (4)

File messages/en.msg

View file
 Retag: Retag
 TagsToAdd: Tags to add
 TagsToRemove: Tags to remove
+BodyFormat: Interpret body as

File src/Handler/Compose.hs

View file
 import System.FilePath ((</>))
 import System.Locale
 import System.Random (randomIO)
+import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
+import Text.Pandoc
 
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Conduit.List as CL
 import qualified Data.Map as M
+import qualified Data.Set as S
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as TL
 
     return (mail, body)
 
+data EmailBodyFormat = EmailBodyQuotedPrintable
+                     | EmailBodyPlain
+                     | EmailBodyMarkdown
+  deriving (Eq, Enum, Bounded)
+
+instance Show EmailBodyFormat where
+    show EmailBodyQuotedPrintable = "Send as text/plain, UTF-8 encoded with quoted printable"
+    show EmailBodyPlain = "Send without altering as text/plain, no charset, no encoding"
+    show EmailBodyMarkdown = "Parse body as markdown; send text and html parts"
+
+pandocWriterOpts :: WriterOptions
+pandocWriterOpts = def
+    { writerWrapText = False
+    }
+
+pandocReaderOpts :: ReaderOptions
+pandocReaderOpts = def
+    { readerExtensions = S.delete Ext_blank_before_blockquote $ readerExtensions def
+    , readerSmart      = True
+    }
+
 -- | Create the body of the outgoing message
-createBody :: (MonadHandler m, HandlerSite m ~ App) => Textarea -> [FileInfo] -> m [Alternatives]
-createBody bodytext attach = do
+createBody :: (MonadHandler m, HandlerSite m ~ App)
+           => EmailBodyFormat -> Textarea -> [FileInfo] -> m [Alternatives]
+createBody fmt bodytext attach = do
     attachParts <- liftResourceT $ forM attach $ \f -> do
         content <- fileSource f $$ CL.consume
         return [Part (fileContentType f) Base64 (Just $ fileName f) [] (BL.fromChunks content)]
 
-    let body = BL.fromChunks [T.encodeUtf8 $ unTextarea bodytext]
+    let b = Part "text/plain" None Nothing [] $ BL.fromChunks [T.encodeUtf8 $ unTextarea bodytext]
+        bq = b { partType = "text/plain; charset=UTF-8", partEncoding = QuotedPrintableText }
+        mkdown = readMarkdown pandocReaderOpts $ T.unpack $ unTextarea bodytext
+        html = renderHtml $ writeHtml pandocWriterOpts mkdown
+        hpart = Part "text/html; charset=UTF-8" QuotedPrintableText Nothing [] html
 
-    return $ [[Part "text/plain" QuotedPrintableText Nothing [] body]] ++ attachParts
+    let body = case fmt of
+                EmailBodyQuotedPrintable -> [bq]
+                EmailBodyPlain -> [b]
+                EmailBodyMarkdown -> [bq, hpart]
+
+    return $ body : attachParts
 
 -- | Create a new message ID
 messageID :: (MonadHandler m, HandlerSite m ~ App) => m T.Text
     (bcc,bccView) <- mopt addressField (fStr "BCC") Nothing
     (subject,sView) <- mreq textField (fI MsgSubject "subj") $ M.lookup "subject" =<< (replyHeaders <$> mreply)
     (head,hView) <- mopt headerField (fI MsgExtraHeader "hdrs") (Just . mailHeaders . fst <$> mmail)
+    (bfmt,fmtView) <- mreq (selectField optionsEnum) (fI MsgBodyFormat "bdyfmt") Nothing
     (body,bView) <- mreq textareaField (fStr "Body") (Textarea . snd <$> mmail)
     (attach,attachView) <- mopt multiFile (fI MsgAttach "attch") Nothing
 
-    parts <- case (,) <$> body <*> attach of
-               FormSuccess (b,a)   -> FormSuccess <$> createBody b (fromMaybe [] a)
+    parts <- case (,,) <$> bfmt <*> body <*> attach of
+               FormSuccess (f,b,a) -> FormSuccess <$> createBody f b (fromMaybe [] a)
                FormFailure err     -> return $ FormFailure err
                FormMissing         -> return $ FormMissing
                
 
         widget = [whamlet|
  #{fmsg}
- $forall v <- [fromView, toView, ccView, bccView, sView, hView]
+ $forall v <- [fromView, toView, ccView, bccView, sView, hView, fmtView]
     <div .control-group .span10>
         <label .control-label for=#{fvId v}>#{fvLabel v}
         <div .controls>

File templates/compose.julius

View file
 $(document).ready(function() {
-    //copied from jquery-mobile
+    //resize body field: copied from jquery-mobile
     var input = $("textarea#body"),
         extraLineHeight = 15,
         keyupTimeoutBuffer = 100,
         keyupTimeout = setTimeout( input._keyup, keyupTimeoutBuffer );
     });
 
+    //restore format setting
+    var oldformat = window.localStorage.getItem("Compose Body Format");
+    if (oldformat) {
+        $("#bdyfmt").val(oldformat);
+    }
+    $("#bdyfmt").change(function() {
+        window.localStorage.setItem("Compose Body Format", $("#bdyfmt").val());
+    });
+
+
     // Now the address fields
     $(".address-field").each(function() {
         var addrs = $(this).val().split(",");

File templates/compose.lucius

View file
     textarea#Body {
         width: 650px;
     }
-    textarea#hdrs, div.controls input {
+    textarea#hdrs, div.controls input, div.controls select {
         width: 400px;
     }
 }