From 8fecbbca3e99828080f658083992ca3b1fe692fe Mon Sep 17 00:00:00 2001 From: Roman Joost Date: Sat, 30 Mar 2019 10:16:33 +1000 Subject: [PATCH] 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 https://github.com/purebred-mua/purebred/issues/182 and https://github.com/purebred-mua/purebred/issues/174 erasf --- src/Config/Main.hs | 6 +++++- src/Types.hs | 4 ++++ src/UI/Actions.hs | 38 ++++++++++++++++++++++++++++++-------- src/UI/Mail/Keybindings.hs | 3 ++- test/TestUserAcceptance.hs | 4 ++-- 5 files changed, 43 insertions(+), 12 deletions(-) diff --git a/src/Config/Main.hs b/src/Config/Main.hs index e3c2158f..6f5e5afb 100644 --- a/src/Config/Main.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs index 22306765..1a1f663e 100644 --- a/src/Types.hs +++ b/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 diff --git a/src/UI/Actions.hs b/src/UI/Actions.hs index 284ef05a..32ede85a 100644 --- a/src/UI/Actions.hs +++ b/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 diff --git a/src/UI/Mail/Keybindings.hs b/src/UI/Mail/Keybindings.hs index 0b373fcf..dc931c59 100644 --- a/src/UI/Mail/Keybindings.hs +++ b/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) ] diff --git a/test/TestUserAcceptance.hs b/test/TestUserAcceptance.hs index 5ef834c4..c01690dd 100644 --- a/test/TestUserAcceptance.hs +++ b/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"