summaryrefslogtreecommitdiff
path: root/lib/Patat/Images/ITerm2.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Patat/Images/ITerm2.hs')
-rw-r--r--lib/Patat/Images/ITerm2.hs58
1 files changed, 58 insertions, 0 deletions
diff --git a/lib/Patat/Images/ITerm2.hs b/lib/Patat/Images/ITerm2.hs
new file mode 100644
index 0000000..a6e7ad4
--- /dev/null
+++ b/lib/Patat/Images/ITerm2.hs
@@ -0,0 +1,58 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Images.ITerm2
+ ( backend
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Exception (throwIO)
+import Control.Monad (unless, when)
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Base64.Lazy as B64
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.List as L
+import Patat.Cleanup (Cleanup)
+import qualified Patat.Images.Internal as Internal
+import System.Environment (lookupEnv)
+
+
+--------------------------------------------------------------------------------
+backend :: Internal.Backend
+backend = Internal.Backend new
+
+
+--------------------------------------------------------------------------------
+data Config = Config deriving (Eq)
+instance A.FromJSON Config where parseJSON _ = return Config
+
+
+--------------------------------------------------------------------------------
+new :: Internal.Config Config -> IO Internal.Handle
+new config = do
+ when (config == Internal.Auto) $ do
+ termProgram <- lookupEnv "TERM_PROGRAM"
+ unless (termProgram == Just "iTerm.app") $ throwIO $
+ Internal.BackendNotSupported "TERM_PROGRAM not iTerm.app"
+
+ return Internal.Handle {Internal.hDrawImage = drawImage}
+
+
+--------------------------------------------------------------------------------
+drawImage :: FilePath -> IO Cleanup
+drawImage path = do
+ content <- BL.readFile path
+ withEscapeSequence $ do
+ putStr "1337;File=inline=1;width=100%;height=100%:"
+ BL.putStr (B64.encode content)
+ return mempty
+
+
+--------------------------------------------------------------------------------
+withEscapeSequence :: IO () -> IO ()
+withEscapeSequence f = do
+ term <- lookupEnv "TERM"
+ let inScreen = maybe False ("screen" `L.isPrefixOf`) term
+ putStr $ if inScreen then "\ESCPtmux;\ESC\ESC]" else "\ESC]"
+ f
+ putStrLn $ if inScreen then "\a\ESC\\" else "\a"