aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/App.hs29
-rw-r--r--src/Text/Pandoc/Highlighting.hs9
-rw-r--r--src/Text/Pandoc/Options.hs3
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs3
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs7
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs46
6 files changed, 66 insertions, 31 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index ce4c87ec1..5391f0fa6 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -57,6 +57,8 @@ import qualified Data.Yaml as Yaml
import Network.URI (URI (..), isURI, parseURI)
import Paths_pandoc (getDataDir)
import Skylighting (Style, Syntax (..), defaultSyntaxMap)
+import Skylighting.Parser (missingIncludes, parseSyntaxDefinition,
+ addSyntaxDefinition)
import System.Console.GetOpt
import System.Directory (Permissions (..), doesFileExist, findExecutable,
getAppUserDataDirectory, getPermissions)
@@ -299,6 +301,21 @@ convertWithOpts opts = do
}
highlightStyle <- lookupHighlightStyle $ optHighlightStyle opts
+ let addSyntaxMap existingmap f = do
+ res <- parseSyntaxDefinition f
+ case res of
+ Left errstr -> err 67 errstr
+ Right syn -> return $ addSyntaxDefinition syn existingmap
+
+ syntaxMap <- foldM addSyntaxMap defaultSyntaxMap
+ (optSyntaxDefinitions opts)
+
+ case missingIncludes (M.elems syntaxMap) of
+ [] -> return ()
+ xs -> err 73 $ "Missing syntax definitions:\n" ++
+ unlines (map
+ (\(syn,dep) -> (T.unpack syn ++ " requires " ++
+ T.unpack dep ++ " through IncludeRules.")) xs)
let writerOptions = def { writerTemplate = templ,
writerVariables = variables,
@@ -330,7 +347,8 @@ convertWithOpts opts = do
writerEpubChapterLevel = optEpubChapterLevel opts,
writerTOCDepth = optTOCDepth opts,
writerReferenceDoc = optReferenceDoc opts,
- writerLaTeXArgs = optLaTeXEngineArgs opts
+ writerLaTeXArgs = optLaTeXEngineArgs opts,
+ writerSyntaxMap = syntaxMap
}
@@ -507,6 +525,7 @@ data Opt = Opt
, optSelfContained :: Bool -- ^ Make HTML accessible offline
, optHtmlQTags :: Bool -- ^ Use <q> tags in HTML
, optHighlightStyle :: Maybe String -- ^ Style to use for highlighted code
+ , optSyntaxDefinitions :: [FilePath] -- ^ xml syntax defs to load
, optTopLevelDivision :: TopLevelDivision -- ^ Type of the top-level divisions
, optHTMLMathMethod :: HTMLMathMethod -- ^ Method to print HTML math
, optAbbreviations :: Maybe FilePath -- ^ Path to abbrevs file
@@ -574,6 +593,7 @@ defaultOpts = Opt
, optSelfContained = False
, optHtmlQTags = False
, optHighlightStyle = Just "pygments"
+ , optSyntaxDefinitions = []
, optTopLevelDivision = TopLevelDefault
, optHTMLMathMethod = PlainMath
, optAbbreviations = Nothing
@@ -987,6 +1007,13 @@ options =
"STYLE")
"" -- "Style for highlighted code"
+ , Option "" ["syntax-definition"]
+ (ReqArg
+ (\arg opt -> return opt{ optSyntaxDefinitions = arg :
+ optSyntaxDefinitions opt })
+ "FILE")
+ "" -- "Syntax definition (xml) file"
+
, Option "H" ["include-in-header"]
(ReqArg
(\arg opt -> return opt{ optIncludeInHeader =
diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
index a4732cd02..f249f96ad 100644
--- a/src/Text/Pandoc/Highlighting.hs
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -76,21 +76,22 @@ languagesByExtension :: String -> [String]
languagesByExtension ext =
[T.unpack (T.toLower (sName s)) | s <- syntaxesByExtension defaultSyntaxMap ext]
-highlight :: (FormatOptions -> [SourceLine] -> a) -- ^ Formatter
+highlight :: SyntaxMap
+ -> (FormatOptions -> [SourceLine] -> a) -- ^ Formatter
-> Attr -- ^ Attributes of the CodeBlock
-> String -- ^ Raw contents of the CodeBlock
-> Either String a
-highlight formatter (_, classes, keyvals) rawCode =
+highlight syntaxmap formatter (_, classes, keyvals) rawCode =
let firstNum = fromMaybe 1 (safeRead (fromMaybe "1" $ lookup "startFrom" keyvals))
fmtOpts = defaultFormatOpts{
startNumber = firstNum,
numberLines = any (`elem`
["number","numberLines", "number-lines"]) classes }
- tokenizeOpts = TokenizerConfig{ syntaxMap = defaultSyntaxMap
+ tokenizeOpts = TokenizerConfig{ syntaxMap = syntaxmap
, traceOutput = False }
classes' = map T.pack classes
rawCode' = T.pack rawCode
- in case msum (map (\l -> lookupSyntax l defaultSyntaxMap) classes') of
+ in case msum (map (\l -> lookupSyntax l syntaxmap) classes') of
Nothing
| numberLines fmtOpts -> Right
$ formatter fmtOpts{ codeClasses = [],
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 0379b0ddf..0b09f0497 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -50,6 +50,7 @@ import Data.Default
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
+import Skylighting (SyntaxMap, defaultSyntaxMap)
import Text.Pandoc.Extensions
import Text.Pandoc.Highlighting (Style, pygments)
@@ -185,6 +186,7 @@ data WriterOptions = WriterOptions
, writerReferenceDoc :: Maybe FilePath -- ^ Path to reference document if specified
, writerLaTeXArgs :: [String] -- ^ Flags to pass to latex-engine
, writerReferenceLocation :: ReferenceLocation -- ^ Location of footnotes and references for writing markdown
+ , writerSyntaxMap :: SyntaxMap
} deriving (Show, Data, Typeable, Generic)
instance Default WriterOptions where
@@ -220,6 +222,7 @@ instance Default WriterOptions where
, writerReferenceDoc = Nothing
, writerLaTeXArgs = []
, writerReferenceLocation = EndOfDocument
+ , writerSyntaxMap = defaultSyntaxMap
}
-- | Returns True if the given extension is enabled.
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 5e4fe7731..fcc8551a4 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -1181,7 +1181,8 @@ inlineToOpenXML' opts (Code attrs str) = do
withTextProp (rCustomStyle "VerbatimChar")
$ if isNothing (writerHighlightStyle opts)
then unhighlighted
- else case highlight formatOpenXML attrs str of
+ else case highlight (writerSyntaxMap opts)
+ formatOpenXML attrs str of
Right h -> return h
Left msg -> do
unless (null msg) $ report $ CouldNotHighlight msg
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 10b782de7..42726bc61 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -642,7 +642,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
then unlines . map ("> " ++) . lines $ rawCode
else rawCode
hlCode = if isJust (writerHighlightStyle opts)
- then highlight formatHtmlBlock
+ then highlight (writerSyntaxMap opts) formatHtmlBlock
(id',classes',keyvals) adjCode
else Left ""
case hlCode of
@@ -885,8 +885,9 @@ inlineToHtml opts inline = do
return $ addAttrs opts (id',[],keyvals) h
where (id',_,keyvals) = attr
hlCode = if isJust (writerHighlightStyle opts)
- then highlight formatHtmlInline
- attr str
+ then highlight
+ (writerSyntaxMap opts)
+ formatHtmlInline attr str
else Left ""
(Strikeout lst) -> inlineListToHtml opts lst >>=
return . H.del
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 44c00df24..eb38485de 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -548,7 +548,8 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do
return $ flush ("\\begin{lstlisting}" <> printParams $$ text str $$
"\\end{lstlisting}") $$ cr
let highlightedCodeBlock =
- case highlight formatLaTeXBlock ("",classes,keyvalAttr) str of
+ case highlight (writerSyntaxMap opts)
+ formatLaTeXBlock ("",classes,keyvalAttr) str of
Left msg -> do
unless (null msg) $
report $ CouldNotHighlight msg
@@ -953,32 +954,33 @@ inlineToLaTeX (Cite cits lst) = do
inlineToLaTeX (Code (_,classes,_) str) = do
opts <- gets stOptions
inHeading <- gets stInHeading
+ let listingsCode = do
+ let listingsopt = case getListingsLanguage classes of
+ Just l -> "[language=" ++ mbBraced l ++ "]"
+ Nothing -> ""
+ inNote <- gets stInNote
+ when inNote $ modify $ \s -> s{ stVerbInNote = True }
+ let chr = case "!\"&'()*,-./:;?@_" \\ str of
+ (c:_) -> c
+ [] -> '!'
+ return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr]
+ let rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}"))
+ $ stringToLaTeX CodeString str
+ where escapeSpaces = concatMap
+ (\c -> if c == ' ' then "\\ " else [c])
+ let highlightCode = do
+ case highlight (writerSyntaxMap opts)
+ formatLaTeXInline ("",classes,[]) str of
+ Left msg -> do
+ unless (null msg) $ report $ CouldNotHighlight msg
+ rawCode
+ Right h -> modify (\st -> st{ stHighlighting = True }) >>
+ return (text (T.unpack h))
case () of
_ | writerListings opts && not inHeading -> listingsCode
| isJust (writerHighlightStyle opts) && not (null classes)
-> highlightCode
| otherwise -> rawCode
- where listingsCode = do
- let listingsopt = case getListingsLanguage classes of
- Just l -> "[language=" ++ mbBraced l ++ "]"
- Nothing -> ""
- inNote <- gets stInNote
- when inNote $ modify $ \s -> s{ stVerbInNote = True }
- let chr = case "!\"&'()*,-./:;?@_" \\ str of
- (c:_) -> c
- [] -> '!'
- return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr]
- highlightCode = do
- case highlight formatLaTeXInline ("",classes,[]) str of
- Left msg -> do
- unless (null msg) $ report $ CouldNotHighlight msg
- rawCode
- Right h -> modify (\st -> st{ stHighlighting = True }) >>
- return (text (T.unpack h))
- rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}"))
- $ stringToLaTeX CodeString str
- where
- escapeSpaces = concatMap (\c -> if c == ' ' then "\\ " else [c])
inlineToLaTeX (Quoted qt lst) = do
contents <- inlineListToLaTeX lst
csquotes <- liftM stCsquotes get
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 17:09:18 +0000