Allow to automatically open attachments

If the lookup for a content type is successful, we use the mapped command,
otherwise show an input editor. Keep the possibility to open the attachment with
a different command by binding the previous open action to a different
keystroke.

A sample mailcap is used and adds a mapping from text/html to elinks and a catch
all to xdg-open. This patch would also fix #174 since it is now possible to
automatically invoke a program to view an HTML attachment.

Fixes #182 and
      #174

erasf

src/Config/Main.hs

@@ -17,7 +17,7 @@ import System.Directory (getHomeDirectory)
 import Data.Maybe (fromMaybe)
 import System.Exit (ExitCode(..))
 
-import Data.MIME (contentTypeTextPlain)
+import Data.MIME (contentTypeTextPlain, matchContentType)
 
 import UI.FileBrowser.Keybindings
        (fileBrowserKeybindings, manageSearchPathKeybindings)
@@ -178,6 +178,10 @@ defaultConfig =
       , _mvMailListOfAttachmentsKeybindings = mailAttachmentsKeybindings
       , _mvOpenWithKeybindings = openWithKeybindings
       , _mvPipeToKeybindings = pipeToKeybindings
+      , _mvMailcap = [
+            ((matchContentType "text" (Just "html")), "elinks -force-html")
+          , (const True, "xdg-open")
+          ]
       }
     , _confIndexView = IndexViewSettings
       { _ivBrowseThreadsKeybindings = browseThreadsKeybindings

src/Types.hs

@@ -347,6 +347,7 @@ data MailViewSettings = MailViewSettings
     , _mvMailListOfAttachmentsKeybindings :: [Keybinding 'ViewMail 'MailListOfAttachments]
     , _mvOpenWithKeybindings :: [Keybinding 'ViewMail 'MailAttachmentOpenWithEditor]
     , _mvPipeToKeybindings :: [Keybinding 'ViewMail 'MailAttachmentPipeToEditor]
+    , _mvMailcap :: [(ContentType -> Bool, String)]
     }
     deriving (Generic, NFData)
 
@@ -374,6 +375,9 @@ mvOpenWithKeybindings = lens _mvOpenWithKeybindings (\s x -> s { _mvOpenWithKeyb
 mvPipeToKeybindings :: Lens' MailViewSettings [Keybinding 'ViewMail 'MailAttachmentPipeToEditor]
 mvPipeToKeybindings = lens _mvPipeToKeybindings (\s x -> s { _mvPipeToKeybindings = x })
 
+mvMailcap :: Lens' MailViewSettings [(ContentType -> Bool, String)]
+mvMailcap = lens _mvMailcap (\s x -> s { _mvMailcap = x })
+
 data ViewName
     = Threads
     | Mails

src/UI/Actions.hs

@@ -61,6 +61,7 @@ module UI.Actions (
   , delete
   , applySearch
   , openWithCommand
+  , openAttachment
   , pipeToCommand
   ) where
 
@@ -92,11 +93,11 @@ import qualified Data.Vector as Vector
 import Prelude hiding (readFile, unlines)
 import Data.Functor (($>))
 import Control.Lens
-       (_Just, to, at, ix, _1, _2, toListOf, traversed, has, snoc,
+       (_Just, to, at, ix, _1, _2, toListOf, traverse, traversed, has, snoc,
         filtered, set, over, preview, view, views, (&), nullOf, firstOf,
-        traversed, traverse, Getting, Lens')
+        Getting, Lens')
 import Control.Concurrent (forkIO)
-import Control.Monad ((>=>))
+import Control.Monad ((>=>), join)
 import Control.Monad.Except (runExceptT)
 import Control.Exception (catch, IOException)
 import Control.Monad.IO.Class (liftIO, MonadIO)
@@ -109,10 +110,10 @@ import Data.MIME
        (createMultipartMixedMessage, contentTypeApplicationOctetStream,
         createTextPlainMessage, createAttachmentFromFile, renderMessage,
         contentDisposition, dispositionType, headers, filename,
-        parseContentType, attachments, isAttachment, entities,
-        matchContentType, contentType, mailboxList, renderMailboxes,
-        addressList, renderAddresses, renderRFC5422Date, MIMEMessage,
-        WireEntity, DispositionType(..), ContentType(..), Mailbox(..))
+        parseContentType, attachments, isAttachment, entities, matchContentType,
+        contentType, mailboxList, renderMailboxes, addressList, renderAddresses,
+        renderRFC5422Date, MIMEMessage, WireEntity, DispositionType(..),
+        ContentType(..), Mailbox(..))
 import qualified Storage.Notmuch as Notmuch
 import Storage.ParsedMail
        (parseMail, getTo, getFrom, getSubject, toQuotedMail, entityToBytes)
@@ -559,10 +560,31 @@ invokeEditor = Action ["invoke external editor"] (Brick.suspendAndResume . liftI
 edit :: Action 'ComposeView 'ComposeListOfAttachments (T.Next AppState)
 edit = Action ["edit file"] (Brick.suspendAndResume . liftIO . editAttachment)
 
+openAttachment :: Action 'ViewMail ctx (T.Next AppState)
+openAttachment =
+  Action
+  { _aDescription = ["open attachment with external command"]
+  , _aAction = \s ->
+      let
+        match ct = firstOf (asConfig . confMailView . mvMailcap . traversed
+                            . filtered (flip fst ct)
+                            . _2) s
+        maybeCommand =
+          join
+          $ match
+          <$> preview (asMailView . mvAttachments . to L.listSelectedElement . _Just . _2 . headers . contentType) s
+      in case maybeCommand of
+           (Just cmd) -> Brick.suspendAndResume $ liftIO $ openCommand' s cmd
+           Nothing ->
+             Brick.continue
+             $ s & set (asViews . vsViews . at ViewMail . _Just . vFocus) MailAttachmentOpenWithEditor
+             . set (asViews . vsViews . at ViewMail . _Just . vWidgets . ix MailAttachmentOpenWithEditor . veState) Visible
+  }
+
 openWithCommand :: Action 'ViewMail 'MailAttachmentOpenWithEditor (T.Next AppState)
 openWithCommand =
   Action
-  { _aDescription = ["pass to external command"]
+  { _aDescription = ["ask for command to open attachment"]
   , _aAction = \s ->
     let cmd = view (asMailView . mvOpenCommand . E.editContentsL . to (T.unpack . currentLine)) s
     in Brick.suspendAndResume $ liftIO $ openCommand' s cmd

src/UI/Mail/Keybindings.hs

@@ -41,7 +41,8 @@ mailAttachmentsKeybindings =
     [ Keybinding (V.EvKey (V.KChar 'j') []) (listDown `chain` continue)
     , Keybinding (V.EvKey (V.KChar 'k') []) (listUp `chain` continue)
     , Keybinding (V.EvKey (V.KChar 'q') []) (abort `chain'` (focus :: Action 'ViewMail 'ScrollingMailView AppState) `chain` continue)
-    , Keybinding (V.EvKey V.KEnter []) (noop `chain'` (focus :: Action 'ViewMail 'MailAttachmentOpenWithEditor AppState) `chain` continue)
+    , Keybinding (V.EvKey V.KEnter []) openAttachment
+    , Keybinding (V.EvKey (V.KChar 'o') []) (noop `chain'` (focus :: Action 'ViewMail 'MailAttachmentOpenWithEditor AppState) `chain` continue)
     , Keybinding (V.EvKey (V.KChar '|') []) (noop `chain'` (focus :: Action 'ViewMail 'MailAttachmentPipeToEditor AppState) `chain` continue)
     ]
 

test/TestUserAcceptance.hs

@@ -196,7 +196,7 @@ testOpenEntitiesSuccessfully = withTmuxSession "open entities successfully" $
     sendKeys "v" (Literal "text/plain")
 
     liftIO $ step "open one entity"
-    sendKeys "Enter" (Literal "Open With")
+    sendKeys "o" (Literal "Open With")
     _ <- sendLiteralKeys "less -e"
 
     sendKeys "Enter" (Regex ("This is a test mail for purebred"
@@ -217,7 +217,7 @@ testOpenCommandDoesNotKillPurebred = withTmuxSession "open attachment does not k
     sendKeys "v" (Literal "text/plain")
 
     liftIO $ step "open with"
-    sendKeys "Enter" (Literal "Open With")
+    sendKeys "o" (Literal "Open With")
 
     liftIO $ step "Open with bogus command"
     _ <- sendLiteralKeys "asdfasdfasdf"