diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Parsing.hs | 7 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 3 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 16 |
4 files changed, 24 insertions, 4 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index c18aa331f..d30c74230 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -161,7 +161,8 @@ module Text.Pandoc.Parsing ( anyLine, setSourceColumn, setSourceLine, newPos, - addWarning + addWarning, + (<+?>) ) where @@ -1245,3 +1246,7 @@ addWarning mbpos msg = generalize :: (Monad m) => Parser s st a -> ParserT s st m a generalize m = mkPT (\ s -> (return $ (return . runIdentity) <$> runIdentity (runParsecT m s))) + +infixr 5 <+?> +(<+?>) :: (Monoid a, Monad m) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a +a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>) diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 59f71589e..52358e51e 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -887,7 +887,7 @@ htmlTag :: Monad m => (Tag String -> Bool) -> ParserT [Char] st m (Tag String, String) htmlTag f = try $ do - lookAhead $ char '<' >> (oneOf "/!?" <|> letter) + lookAhead $ char '<' >> ((oneOf "/!?" >> nonspaceChar) <|> letter) (next : _) <- getInput >>= return . canonicalizeTags . parseTags guard $ f next -- advance the parser diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index ccda83576..5e0cef4f8 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1487,7 +1487,8 @@ code = try $ do math :: MarkdownParser Inlines math = (B.displayMath <$> (mathDisplay >>= applyMacros')) - <|> (B.math <$> (mathInline >>= applyMacros')) + <|> ((B.math <$> (mathInline >>= applyMacros')) <+?> + ((getOption readerSmart >>= guard) *> apostrophe <* notFollowedBy space)) -- Parses material enclosed in *s, **s, _s, or __s. -- Designed to avoid backtracking. diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index b32be06ae..4809d2a14 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -110,6 +110,7 @@ data WriterState = WriterState{ , stPrintWidth :: Integer , stStyleMaps :: StyleMaps , stFirstPara :: Bool + , stTocTitle :: [Inline] } defaultWriterState :: WriterState @@ -131,6 +132,7 @@ defaultWriterState = WriterState{ , stPrintWidth = 1 , stStyleMaps = defaultStyleMaps , stFirstPara = False + , stTocTitle = normalizeInlines [Str "Table of Contents"] } type WS a = StateT WriterState IO a @@ -193,6 +195,13 @@ isValidChar (ord -> c) | 0x10000 <= c && c <= 0x10FFFF = True | otherwise = False +metaValueToInlines :: MetaValue -> [Inline] +metaValueToInlines (MetaString s) = normalizeInlines [Str s] +metaValueToInlines (MetaInlines ils) = ils +metaValueToInlines (MetaBlocks bs) = query return bs +metaValueToInlines (MetaBool b) = [Str $ show b] +metaValueToInlines _ = [] + -- | Produce an Docx file from a Pandoc document. writeDocx :: WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert @@ -235,11 +244,15 @@ writeDocx opts doc@(Pandoc meta _) = do -- parse styledoc for heading styles let styleMaps = getStyleMaps styledoc + let tocTitle = fromMaybe (stTocTitle defaultWriterState) $ + metaValueToInlines <$> lookupMeta "toc-title" meta + ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc') defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime , stPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth) , stStyleMaps = styleMaps + , stTocTitle = tocTitle } let epochtime = floor $ utcTimeToPOSIXSeconds utctime let imgs = M.elems $ stImages st @@ -626,7 +639,8 @@ makeTOC :: WriterOptions -> WS [Element] makeTOC opts | writerTableOfContents opts = do let depth = "1-"++(show (writerTOCDepth opts)) let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u" - title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para [Str "Table of Contents"]]) + tocTitle <- gets stTocTitle + title <- withParaPropM (pStyleM "TOC Heading") (blocksToOpenXML opts [Para tocTitle]) return $ [mknode "w:sdt" [] ([ mknode "w:sdtPr" [] ( |