80d0938 · typeable/pandoc

git.iko.soy/typeable/pandoc

Allow dynamic loading of syntax definitions.

See #3334. * Add writerSyntaxMap to WriterOptions. * Highlighting: added parameter for SyntaxMap to highlight. * Implemented --syntax-definition option. TODO: [ ] Figure out whether we want to have the xml parsing depend on the dtd (it currently does, and fails unless the language.dtd is found in the same directory). [ ] Add an option to read a KDE syntax highlighting theme as a custom style. [ ] Add tests.

commit80d093843b4f782dda73054d4fc4ba9ef2a82843 authorJohn MacFarlane <jgm@berkeley.edu> dateThu 30 Mar 2017, 21:51 (10 years ago) parentea84cd0

7 files changed+74−31

compare with master

unifiedsplit

MANUAL.txt+8 src/Text/Pandoc/App.hs+28−1 src/Text/Pandoc/Highlighting.hs+5−4 src/Text/Pandoc/Options.hs+3 src/Text/Pandoc/Writers/Docx.hs+2−1 src/Text/Pandoc/Writers/HTML.hs+4−3 src/Text/Pandoc/Writers/LaTeX.hs+24−22

MANUAL.txt+8

@@ -639,6 +639,14 @@ General writer options

639639 [Syntax highlighting], below. See also

640640 `--list-highlight-styles`.

641641

642+`--syntax-definition=`*FILE*

643+

644+: Instructs pandoc to load a KDE XML syntax definition file,

645+ which will be used for syntax highlighting of appropriately

646+ marked code blocks. This can be used to add support for

647+ new languages or to use altered syntax definitions for

648+ existing languages.

649+

642650`-H` *FILE*, `--include-in-header=`*FILE*

643651

644652: Include contents of *FILE*, verbatim, at the end of the header.

src/Text/Pandoc/App.hs+28−1

@@ -57,6 +57,8 @@ import qualified Data.Yaml as Yaml

5757import Network.URI (URI (..), isURI, parseURI)

5858import Paths_pandoc (getDataDir)

5959import Skylighting (Style, Syntax (..), defaultSyntaxMap)

60+import Skylighting.Parser (missingIncludes, parseSyntaxDefinition,

61+ addSyntaxDefinition)

6062import System.Console.GetOpt

6163import System.Directory (Permissions (..), doesFileExist, findExecutable,

6264 getAppUserDataDirectory, getPermissions)

@@ -299,6 +301,21 @@ convertWithOpts opts = do

299301 }

300302

301303 highlightStyle <- lookupHighlightStyle $ optHighlightStyle opts

304+ let addSyntaxMap existingmap f = do

305+ res <- parseSyntaxDefinition f

306+ case res of

307+ Left errstr -> err 67 errstr

308+ Right syn -> return $ addSyntaxDefinition syn existingmap

309+

310+ syntaxMap <- foldM addSyntaxMap defaultSyntaxMap

311+ (optSyntaxDefinitions opts)

312+

313+ case missingIncludes (M.elems syntaxMap) of

314+ [] -> return ()

315+ xs -> err 73 $ "Missing syntax definitions:\n" ++

316+ unlines (map

317+ (\(syn,dep) -> (T.unpack syn ++ " requires " ++

318+ T.unpack dep ++ " through IncludeRules.")) xs)

302319

303320 let writerOptions = def { writerTemplate = templ,

304321 writerVariables = variables,

@@ -330,7 +347,8 @@ convertWithOpts opts = do

330347 writerEpubChapterLevel = optEpubChapterLevel opts,

331348 writerTOCDepth = optTOCDepth opts,

332349 writerReferenceDoc = optReferenceDoc opts,

333− writerLaTeXArgs = optLaTeXEngineArgs opts

350+ writerLaTeXArgs = optLaTeXEngineArgs opts,

351+ writerSyntaxMap = syntaxMap

334352 }

335353

336354

@@ -507,6 +525,7 @@ data Opt = Opt

507525 , optSelfContained :: Bool -- ^ Make HTML accessible offline

508526 , optHtmlQTags :: Bool -- ^ Use <q> tags in HTML

509527 , optHighlightStyle :: Maybe String -- ^ Style to use for highlighted code

528+ , optSyntaxDefinitions :: [FilePath] -- ^ xml syntax defs to load

510529 , optTopLevelDivision :: TopLevelDivision -- ^ Type of the top-level divisions

511530 , optHTMLMathMethod :: HTMLMathMethod -- ^ Method to print HTML math

512531 , optAbbreviations :: Maybe FilePath -- ^ Path to abbrevs file

@@ -574,6 +593,7 @@ defaultOpts = Opt

574593 , optSelfContained = False

575594 , optHtmlQTags = False

576595 , optHighlightStyle = Just "pygments"

596+ , optSyntaxDefinitions = []

577597 , optTopLevelDivision = TopLevelDefault

578598 , optHTMLMathMethod = PlainMath

579599 , optAbbreviations = Nothing

@@ -987,6 +1007,13 @@ options =

9871007 "STYLE")

9881008 "" -- "Style for highlighted code"

9891009

1010+ , Option "" ["syntax-definition"]

1011+ (ReqArg

1012+ (\arg opt -> return opt{ optSyntaxDefinitions = arg :

1013+ optSyntaxDefinitions opt })

1014+ "FILE")

1015+ "" -- "Syntax definition (xml) file"

1016+

9901017 , Option "H" ["include-in-header"]

9911018 (ReqArg

9921019 (\arg opt -> return opt{ optIncludeInHeader =

src/Text/Pandoc/Highlighting.hs+5−4

@@ -76,21 +76,22 @@ languagesByExtension :: String -> [String]

7676languagesByExtension ext =

7777 [T.unpack (T.toLower (sName s)) | s <- syntaxesByExtension defaultSyntaxMap ext]

7878

79−highlight :: (FormatOptions -> [SourceLine] -> a) -- ^ Formatter

79+highlight :: SyntaxMap

80+ -> (FormatOptions -> [SourceLine] -> a) -- ^ Formatter

8081 -> Attr -- ^ Attributes of the CodeBlock

8182 -> String -- ^ Raw contents of the CodeBlock

8283 -> Either String a

83−highlight formatter (_, classes, keyvals) rawCode =

84+highlight syntaxmap formatter (_, classes, keyvals) rawCode =

8485 let firstNum = fromMaybe 1 (safeRead (fromMaybe "1" $ lookup "startFrom" keyvals))

8586 fmtOpts = defaultFormatOpts{

8687 startNumber = firstNum,

8788 numberLines = any (`elem`

8889 ["number","numberLines", "number-lines"]) classes }

89− tokenizeOpts = TokenizerConfig{ syntaxMap = defaultSyntaxMap

90+ tokenizeOpts = TokenizerConfig{ syntaxMap = syntaxmap

9091 , traceOutput = False }

9192 classes' = map T.pack classes

9293 rawCode' = T.pack rawCode

93− in case msum (map (\l -> lookupSyntax l defaultSyntaxMap) classes') of

94+ in case msum (map (\l -> lookupSyntax l syntaxmap) classes') of

9495 Nothing

9596 | numberLines fmtOpts -> Right

9697 $ formatter fmtOpts{ codeClasses = [],

src/Text/Pandoc/Options.hs+3

@@ -50,6 +50,7 @@ import Data.Default

5050import qualified Data.Set as Set

5151import Data.Typeable (Typeable)

5252import GHC.Generics (Generic)

53+import Skylighting (SyntaxMap, defaultSyntaxMap)

5354import Text.Pandoc.Extensions

5455import Text.Pandoc.Highlighting (Style, pygments)

5556

@@ -185,6 +186,7 @@ data WriterOptions = WriterOptions

185186 , writerReferenceDoc :: Maybe FilePath -- ^ Path to reference document if specified

186187 , writerLaTeXArgs :: [String] -- ^ Flags to pass to latex-engine

187188 , writerReferenceLocation :: ReferenceLocation -- ^ Location of footnotes and references for writing markdown

189+ , writerSyntaxMap :: SyntaxMap

188190 } deriving (Show, Data, Typeable, Generic)

189191

190192instance Default WriterOptions where

@@ -220,6 +222,7 @@ instance Default WriterOptions where

220222 , writerReferenceDoc = Nothing

221223 , writerLaTeXArgs = []

222224 , writerReferenceLocation = EndOfDocument

225+ , writerSyntaxMap = defaultSyntaxMap

223226 }

224227

225228-- | Returns True if the given extension is enabled.

src/Text/Pandoc/Writers/Docx.hs+2−1

@@ -1181,7 +1181,8 @@ inlineToOpenXML' opts (Code attrs str) = do

11811181 withTextProp (rCustomStyle "VerbatimChar")

11821182 $ if isNothing (writerHighlightStyle opts)

11831183 then unhighlighted

1184− else case highlight formatOpenXML attrs str of

1184+ else case highlight (writerSyntaxMap opts)

1185+ formatOpenXML attrs str of

11851186 Right h -> return h

11861187 Left msg -> do

11871188 unless (null msg) $ report $ CouldNotHighlight msg

src/Text/Pandoc/Writers/HTML.hs+4−3

@@ -642,7 +642,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do

642642 then unlines . map ("> " ++) . lines $ rawCode

643643 else rawCode

644644 hlCode = if isJust (writerHighlightStyle opts)

645− then highlight formatHtmlBlock

645+ then highlight (writerSyntaxMap opts) formatHtmlBlock

646646 (id',classes',keyvals) adjCode

647647 else Left ""

648648 case hlCode of

@@ -885,8 +885,9 @@ inlineToHtml opts inline = do

885885 return $ addAttrs opts (id',[],keyvals) h

886886 where (id',_,keyvals) = attr

887887 hlCode = if isJust (writerHighlightStyle opts)

888− then highlight formatHtmlInline

889− attr str

888+ then highlight

889+ (writerSyntaxMap opts)

890+ formatHtmlInline attr str

890891 else Left ""

891892 (Strikeout lst) -> inlineListToHtml opts lst >>=

892893 return . H.del

src/Text/Pandoc/Writers/LaTeX.hs+24−22

@@ -548,7 +548,8 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do

548548 return $ flush ("\\begin{lstlisting}" <> printParams $$ text str $$

549549 "\\end{lstlisting}") $$ cr

550550 let highlightedCodeBlock =

551− case highlight formatLaTeXBlock ("",classes,keyvalAttr) str of

551+ case highlight (writerSyntaxMap opts)

552+ formatLaTeXBlock ("",classes,keyvalAttr) str of

552553 Left msg -> do

553554 unless (null msg) $

554555 report $ CouldNotHighlight msg

@@ -953,32 +954,33 @@ inlineToLaTeX (Cite cits lst) = do

953954inlineToLaTeX (Code (_,classes,_) str) = do

954955 opts <- gets stOptions

955956 inHeading <- gets stInHeading

957+ let listingsCode = do

958+ let listingsopt = case getListingsLanguage classes of

959+ Just l -> "[language=" ++ mbBraced l ++ "]"

960+ Nothing -> ""

961+ inNote <- gets stInNote

962+ when inNote $ modify $ \s -> s{ stVerbInNote = True }

963+ let chr = case "!\"&'()*,-./:;?@_" \\ str of

964+ (c:_) -> c

965+ [] -> '!'

966+ return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr]

967+ let rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}"))

968+ $ stringToLaTeX CodeString str

969+ where escapeSpaces = concatMap

970+ (\c -> if c == ' ' then "\\ " else [c])

971+ let highlightCode = do

972+ case highlight (writerSyntaxMap opts)

973+ formatLaTeXInline ("",classes,[]) str of

974+ Left msg -> do

975+ unless (null msg) $ report $ CouldNotHighlight msg

976+ rawCode

977+ Right h -> modify (\st -> st{ stHighlighting = True }) >>

978+ return (text (T.unpack h))

956979 case () of

957980 _ | writerListings opts && not inHeading -> listingsCode

958981 | isJust (writerHighlightStyle opts) && not (null classes)

959982 -> highlightCode

960983 | otherwise -> rawCode

961− where listingsCode = do

962− let listingsopt = case getListingsLanguage classes of

963− Just l -> "[language=" ++ mbBraced l ++ "]"

964− Nothing -> ""

965− inNote <- gets stInNote

966− when inNote $ modify $ \s -> s{ stVerbInNote = True }

967− let chr = case "!\"&'()*,-./:;?@_" \\ str of

968− (c:_) -> c

969− [] -> '!'

970− return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr]

971− highlightCode = do

972− case highlight formatLaTeXInline ("",classes,[]) str of

973− Left msg -> do

974− unless (null msg) $ report $ CouldNotHighlight msg

975− rawCode

976− Right h -> modify (\st -> st{ stHighlighting = True }) >>

977− return (text (T.unpack h))

978− rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}"))

979− $ stringToLaTeX CodeString str

980− where

981− escapeSpaces = concatMap (\c -> if c == ' ' then "\\ " else [c])

982984inlineToLaTeX (Quoted qt lst) = do

983985 contents <- inlineListToLaTeX lst

984986 csquotes <- liftM stCsquotes get