diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,13 @@ +### 0.3.0.0 + +- Support for packages *base* < *4.8* and *pandoc-types* < *1.20* was + dropped. +- If output format is *gfm*, the code block gets translated to a *RawBlock* in + *HTML* format with style adhered to code blocks in Github README pages. +- Use environment variable *VIMRC_PANDOC* to point to the custom vim + configuration. +- Cabal flag *debug* was removed. + ### 0.2.0.1 - Removed dependency on package *safe*. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2016-2023, Alexey Radkov. All rights reserved. +Copyright 2016-2024, Alexey Radkov. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/pandoc-vimhl.cabal b/pandoc-vimhl.cabal --- a/pandoc-vimhl.cabal +++ b/pandoc-vimhl.cabal @@ -1,5 +1,5 @@ name: pandoc-vimhl -version: 0.2.0.1 +version: 0.3.0.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 @@ -10,28 +10,20 @@ extra-doc-files: Changelog.md author: Alexey Radkov maintainer: Alexey Radkov -copyright: 2016-2023 Alexey Radkov +copyright: 2016-2024 Alexey Radkov category: Text build-type: Simple cabal-version: 1.20 -flag debug - description: Enable debug support (print how vim runs to stderr) - default: False - manual: True - executable vimhl default-language: Haskell2010 - build-depends: base >= 4.7 && < 5 - , pandoc-types >= 1.12 + build-depends: base >= 4.8 && < 5 + , pandoc-types >= 1.20 , directory >= 1.3.3.0 , filepath , process , temporary >= 1.1 , text - - if flag(debug) - cpp-options: -DDEBUG ghc-options: -Wall diff --git a/vimhl.hs b/vimhl.hs --- a/vimhl.hs +++ b/vimhl.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings, LambdaCase #-} import Text.Pandoc.JSON import System.IO (IOMode (WriteMode), openFile, hFlush) @@ -17,38 +17,18 @@ import Data.Function (on) import Control.Arrow import Control.Monad -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif import Control.Exception (bracket) -#if MIN_VERSION_pandoc_types(1,20,0) -import Prelude hiding (readFile) -import Data.Text.IO (readFile) -import qualified Data.Text.IO as P (hPutStr) -import Data.Text (Text, unpack) -#else -import qualified System.IO as P (hPutStr) -#endif -#ifdef DEBUG -import System.IO (hPutStr, hPutStrLn, stderr) -#endif - -#if MIN_VERSION_pandoc_types(1,20,0) -tOSTRING :: Text -> String -tOSTRING = unpack -#else -tOSTRING :: String -> String -tOSTRING = id -#endif +import qualified Data.Text as T +import qualified Data.Text.IO as T vimHl :: Maybe Format -> Block -> IO Block vimHl (Just fm@(Format fmt)) (CodeBlock (_, cls@(ft : _), namevals) contents) - | lookup "hl" namevals' == Just "vim" && fmt' `elem` ["html", "latex"] = do - let vimhlcmd = unwords [cmd fmt', nmb] - where cmd "html" = "MakeHtmlCodeHighlight" - cmd "latex" = "MakeTexCodeHighlight" - cmd _ = undefined - nmb | "numberLines" `elem` cls' = + | lookup "hl" namevals' == Just "vim" && + fmt `elem` ["html", "latex", "gfm"] = do + let vimhlcmd = unwords [cmd fmt, nmb] + where cmd "latex" = "MakeTexCodeHighlight" + cmd _ = "MakeHtmlCodeHighlight" + nmb | "numberLines" `elem` cls = fromMaybe "-1" $ lookup "startfrom" namevals' | otherwise = "" colorscheme = maybe "" (("-c 'let g:PhColorscheme = \"" ++) @@ -67,26 +47,24 @@ strip = dropWhileEnd isSpace . dropWhile isSpace vimrccmd <- do home <- getHomeDirectory `catchIOError` const (return "") - let vimrc = home ".vimrc.pandoc" - exists = doesFileExist &&> (fmap readable . getPermissions) + 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 - P.hPutStr hsrc contents >> hFlush hsrc + 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=" ++ ft', "|" + ,"-c 'set ft=" ++ T.unpack ft, "|" ,vimhlcmd ++ "' -c 'w!", dst ++ "' -c 'qa!'" ,src ] -#ifdef DEBUG - hPutStr stderr $ vimcmd ++ " ... " -#endif {- 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 @@ -99,16 +77,35 @@ (_, _, _, handle) <- createProcess (shell vimcmd) {std_in = UseHandle hin, std_out = UseHandle hout} r <- waitForProcess handle -#ifdef DEBUG - hPutStrLn stderr $ show r -#endif unless (r == ExitSuccess) $ exitWith r - readFile dst - return $ RawBlock fm block - where fmt' = tOSTRING fmt - cls' = map tOSTRING cls - ft' = tOSTRING ft - namevals' = map (map toLower . tOSTRING *** tOSTRING) namevals + T.readFile dst + return $ RawBlock fm' $ wrap fm block + where namevals' = map (map toLower . T.unpack *** T.unpack) namevals + fm' | fm == Format "latex" = fm + | otherwise = Format "html" + wrap "gfm" block = T.concat + ["
" + ,block + ,"
" + ] + wrap _ block = block + escapeHtml = T.concatMap $ \case + '<' -> "<" + '>' -> ">" + '&' -> "&" + '"' -> """ + '\'' -> "'" + x -> T.singleton x + stripShellOutputPrompt t + | ft == "shelloutput" = + let prompt = "||| " + in T.replace ("\n" `T.append` prompt) "\n" $ + fromMaybe t $ T.stripPrefix prompt t + | otherwise = t vimHl _ cb = return cb main :: IO ()