do not use /dev/tty if the backend program is Neovim

pandoc/haskell/Changelog.md

@@ -1,3 +1,11 @@
+### 0.3.2.0
+
+- Improvement after the previous release: do not use */dev/tty* if the backend
+  program is Neovim. The backend's flavor gets detected by testing against
+  *has("nvim")* once at the first call.
+- As well, both the vim executable and the effective vim configuration file get
+  detected once at the first call.
+
 ### 0.3.1.0
 
 - Do not throw the error if */dev/tty* cannot be open. Note that Neovim loads

pandoc/haskell/pandoc-vimhl.cabal

@@ -1,5 +1,5 @@
 name:                    pandoc-vimhl
-version:                 0.3.1.0
+version:                 0.3.2.0
 synopsis:                Pandoc filter for native Vim code highlighting
 description:             Pandoc filter for native Vim code highlighting
         in HTML and PDF documents. Requires Vim (or Neovim) and plugin

pandoc/haskell/vimhl.hs

@@ -4,6 +4,7 @@ import Text.Pandoc.JSON
 import System.IO (IOMode (WriteMode), openFile, hFlush)
 import System.IO.Temp
 import System.IO.Error
+import System.IO.Unsafe
 import System.Environment (lookupEnv)
 import System.Directory
 import System.Directory.Internal (andM)
@@ -45,43 +46,35 @@ vimHl (Just fm@(Format fmt)) (CodeBlock (_, cls@(ft : _), namevals) contents)
                       cmd (x, y) = mkCmd x y
                       mkCmd x y = "--cmd 'let g:" ++ x ++ " = \"" ++ y ++ "\"'"
                       strip = dropWhileEnd isSpace . dropWhile isSpace
-        vimrccmd <- do
-            home <- getHomeDirectory `catchIOError` const (return "")
-            vimrc <- fromMaybe (home </> ".vimrc.pandoc") <$>
-                lookupEnv "VIMRC_PANDOC"
-            let exists = doesFileExist &&> (fmap readable . getPermissions)
-                (&&>) = liftM2 andM
-                (<<$) = liftM2 (<$>)
-            (bool "" . ("--noplugin -u '" ++) . (++ "'")) <<$ exists $ vimrc
         block <- withSystemTempFile "_vimhl_src." $ \src hsrc -> do
             T.hPutStr hsrc contents >> hFlush hsrc
-            bracket (emptySystemTempFile "_vimhl_dst.") removeFile $
-                \dst -> do
-                    vimexe <- fromMaybe "vim" <$> lookupEnv "VIMHL_BACKEND"
-                    let vimcmd =
-                            unwords
-                                [vimexe, "-Nen", cmds, vimrccmd, colorscheme
-                                ,"-c 'set ft=" ++ T.unpack ft, "|"
-                                ,vimhlcmd ++ "' -c 'w!", dst ++ "' -c 'qa!'"
-                                ,src
-                                ]
-                    {- Vim must think that it was launched from a terminal,
-                     - otherwise it won't load its usual environment and the
-                     - syntax engine! Using WriteMode for stdin prevents Vim
-                     - from getting unresponsive on Ctrl-C interrupts while
-                     - still doing well its task (Vim checks that input is a
-                     - terminal using isatty(), however it does not check the
-                     - mode of the handle). Note that Neovim loads the syntax
-                     - engine without tty emulation just fine. -}
-                    hin <- (Just <$> openFile "/dev/tty" WriteMode)
-                        `catchIOError` const (return Nothing)
-                    hout <- openFile "/dev/null" WriteMode
-                    (_, _, _, handle) <- createProcess $
-                        let cmd = (shell vimcmd) {std_out = UseHandle hout}
-                        in maybe cmd (\h -> cmd {std_in = UseHandle h}) hin
-                    r <- waitForProcess handle
-                    unless (r == ExitSuccess) $ exitWith r
-                    T.readFile dst
+            bracket (emptySystemTempFile "_vimhl_dst.") removeFile $ \dst -> do
+                let vimrccmd = maybe "" (("--noplugin -u '" ++) . (++ "'"))
+                        vimrcPandoc
+                    vimcmd = unwords
+                        [vimExe, "-Nen", cmds, vimrccmd, colorscheme
+                        ,"-c 'set ft=" ++ T.unpack ft, "|"
+                        ,vimhlcmd ++ "' -c 'w!", dst ++ "' -c 'qa!'"
+                        ,src
+                        ]
+                {- Vim must think that it has been launched from a terminal,
+                 - otherwise it won't load its usual environment and the syntax
+                 - engine! Using WriteMode for stdin prevents Vim from getting
+                 - unresponsive on Ctrl-C interrupts while it still keeps doing
+                 - well its task (Vim checks that input is a terminal using
+                 - isatty(), however it does not check the mode of the handle).
+                 - Note that Neovim loads the syntax engine without tty
+                 - emulation just fine. -}
+                hin <- if vimExeIsNvim
+                           then return Nothing
+                           else Just <$> openFile "/dev/tty" WriteMode
+                hout <- openFile "/dev/null" WriteMode
+                (_, _, _, handle) <- createProcess $
+                    let cmd = (shell vimcmd) {std_out = UseHandle hout}
+                    in maybe cmd (\h -> cmd {std_in = UseHandle h}) hin
+                r <- waitForProcess handle
+                unless (r == ExitSuccess) $ exitWith r
+                T.readFile dst
         return $ RawBlock fm' $ wrap fm block
     where namevals' = map (map toLower . T.unpack *** T.unpack) namevals
           fm' | fm == Format "latex" = fm
@@ -113,6 +106,39 @@ vimHl (Just fm@(Format fmt)) (CodeBlock (_, cls@(ft : _), namevals) contents)
               | otherwise = t
 vimHl _ cb = return cb
 
+vimExe :: String
+vimExe = unsafePerformIO $ fromMaybe "vim" <$> lookupEnv "VIMHL_BACKEND"
+{-# NOINLINE vimExe #-}
+
+vimExeIsNvim :: Bool
+vimExeIsNvim = unsafePerformIO $
+    bracket (emptySystemTempFile "_vimhl_test.") removeFile $ \test -> do
+        let vimcmd = unwords
+                [vimExe
+                ,"-Nens --noplugin -u NONE \
+                 \-c 'if has(\"nvim\") | exe \"normal i1\" | endif' -c wq"
+                ,test
+                ]
+        hout <- openFile "/dev/null" WriteMode
+        (_, _, _, handle) <- createProcess $
+            (shell vimcmd) {std_out = UseHandle hout}
+        r <- waitForProcess handle
+        unless (r == ExitSuccess) $ exitWith r
+        maybe False (('1' ==) . fst) . T.uncons <$> T.readFile test
+{-# NOINLINE vimExeIsNvim #-}
+
+vimrcPandoc :: Maybe String
+vimrcPandoc = unsafePerformIO $ lookupEnv "VIMRC_PANDOC" >>=
+    maybe (do
+               home <- getHomeDirectory `catchIOError` const (return "")
+               let vimrc = home </> ".vimrc.pandoc"
+                   exists = doesFileExist &&> (fmap readable . getPermissions)
+                   (&&>) = liftM2 andM
+                   (<<$) = liftM2 (<$>)
+               (bool Nothing . Just) <<$ exists $ vimrc
+          ) (return . Just)
+{-# NOINLINE vimrcPandoc #-}
+
 main :: IO ()
 main = toJSONFilter vimHl