diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Readers/DocBook.hs | 20 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Docx/Reducible.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 67 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 13 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 7 |
7 files changed, 84 insertions, 37 deletions
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 1e119e729..59ff3e717 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -6,6 +6,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.XML.Light import Text.Pandoc.Compat.TagSoupEntity (lookupEntity) +import Data.Either (rights) import Data.Generics import Data.Monoid import Data.Char (isSpace) @@ -13,6 +14,7 @@ import Control.Monad.State import Control.Applicative ((<$>)) import Data.List (intersperse) import Data.Maybe (fromMaybe) +import Text.TeXMath (readMathML, writeTeX) {- @@ -126,7 +128,7 @@ List of all DocBook tags, with [x] indicating implemented, [ ] envar - A software environment variable [x] epigraph - A short inscription at the beginning of a document or component note: also handle embedded attribution tag -[ ] equation - A displayed mathematical equation +[x] equation - A displayed mathematical equation [ ] errorcode - An error code [ ] errorname - An error name [ ] errortext - An error message. @@ -185,12 +187,12 @@ List of all DocBook tags, with [x] indicating implemented, [x] indexinfo - Meta-information for an Index [x] indexterm - A wrapper for terms to be indexed [x] info - A wrapper for information about a component or other block. (DocBook v5) -[ ] informalequation - A displayed mathematical equation without a title +[x] informalequation - A displayed mathematical equation without a title [ ] informalexample - A displayed example without a title [ ] informalfigure - A untitled figure [ ] informaltable - A table without a title [ ] initializer - The initializer for a FieldSynopsis -[ ] inlineequation - A mathematical equation or expression occurring inline +[x] inlineequation - A mathematical equation or expression occurring inline [ ] inlinegraphic - An object containing or pointing to graphical data that will be rendered inline [x] inlinemediaobject - An inline media object (video, audio, image, and so on) @@ -239,7 +241,7 @@ List of all DocBook tags, with [x] indicating implemented, [ ] methodname - The name of a method [ ] methodparam - Parameters to a method [ ] methodsynopsis - A syntax summary for a method -[ ] mml:math - A MathML equation +[x] mml:math - A MathML equation [ ] modespec - Application-specific information necessary for the completion of an OLink [ ] modifier - Modifiers in a synopsis @@ -882,6 +884,9 @@ parseInline (CRef ref) = return $ maybe (text $ map toUpper ref) (text . (:[])) $ lookupEntity ref parseInline (Elem e) = case qName (elName e) of + "equation" -> equation displayMath + "informalequation" -> equation displayMath + "inlineequation" -> equation math "subscript" -> subscript <$> innerInlines "superscript" -> superscript <$> innerInlines "inlinemediaobject" -> getImage e @@ -943,6 +948,13 @@ parseInline (Elem e) = _ -> innerInlines where innerInlines = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e) + equation constructor = return $ mconcat $ + map (constructor . writeTeX) + $ rights + $ map (readMathML . showElement . everywhere (mkT removePrefix)) + $ filterChildren (\x -> qName (elName x) == "math" && + qPrefix (elName x) == Just "mml") e + removePrefix elname = elname { qPrefix = Nothing } codeWithLang = do let classes' = case attrValue "language" e of "" -> [] diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index c856ca30a..9943ebeb8 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -462,7 +462,7 @@ bodyPartToBlocks (Paragraph pPr parparts) bodyPartToBlocks (Paragraph pPr parparts) = do ils <- parPartsToInlines parparts >>= (return . normalizeSpaces) dropIls <- gets docxDropCap - let ils' = reduceList $ dropIls ++ ils + let ils' = concatR dropIls ils if dropCap pPr then do modify $ \s -> s { docxDropCap = ils' } return [] diff --git a/src/Text/Pandoc/Readers/Docx/Reducible.hs b/src/Text/Pandoc/Readers/Docx/Reducible.hs index a852e25bf..39a93d988 100644 --- a/src/Text/Pandoc/Readers/Docx/Reducible.hs +++ b/src/Text/Pandoc/Readers/Docx/Reducible.hs @@ -39,6 +39,7 @@ module Text.Pandoc.Readers.Docx.Reducible ((<++>), innards, reduceList, reduceListB, + concatR, rebuild) where @@ -78,6 +79,15 @@ reduceList' as (x:xs) = reduceList' (init as ++ (last as <++> x) ) xs reduceList :: (Reducible a) => [a] -> [a] reduceList = reduceList' [] +concatR :: (Reducible a) => [a] -> [a] -> [a] +concatR [] [] = [] +concatR [] ss = ss +concatR rs [] = rs +concatR rs ss = let (x:xs) = reverse rs + (y:ys) = ss + in + reverse xs ++ ( x <++> y ) ++ ys + combineReducibles :: (Reducible a, Eq a) => a -> a -> [a] combineReducibles r s = let (conts, rs) = topLevelContainers r diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 861f81b23..26ea764be 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -141,14 +141,16 @@ nonindentSpaces = do then return sps else unexpected "indented line" -skipNonindentSpaces :: MarkdownParser () +-- returns number of spaces parsed +skipNonindentSpaces :: MarkdownParser Int skipNonindentSpaces = do tabStop <- getOption readerTabStop - atMostSpaces (tabStop - 1) + atMostSpaces (tabStop - 1) <* notFollowedBy (char ' ') -atMostSpaces :: Int -> MarkdownParser () -atMostSpaces 0 = notFollowedBy (char ' ') -atMostSpaces n = (char ' ' >> atMostSpaces (n-1)) <|> return () +atMostSpaces :: Int -> MarkdownParser Int +atMostSpaces n + | n > 0 = (char ' ' >> (+1) <$> atMostSpaces (n-1)) <|> return 0 + | otherwise = return 0 litChar :: MarkdownParser Char litChar = escapedChar' @@ -717,35 +719,42 @@ blockQuote = do bulletListStart :: MarkdownParser () bulletListStart = try $ do optional newline -- if preceded by a Plain block in a list context + startpos <- sourceColumn <$> getPosition skipNonindentSpaces notFollowedBy' (() <$ hrule) -- because hrules start out just like lists satisfy isBulletListMarker - spaceChar <|> lookAhead newline - skipSpaces + endpos <- sourceColumn <$> getPosition + tabStop <- getOption readerTabStop + lookAhead (newline <|> spaceChar) + () <$ atMostSpaces (tabStop - (endpos - startpos)) anyOrderedListStart :: MarkdownParser (Int, ListNumberStyle, ListNumberDelim) anyOrderedListStart = try $ do optional newline -- if preceded by a Plain block in a list context + startpos <- sourceColumn <$> getPosition skipNonindentSpaces notFollowedBy $ string "p." >> spaceChar >> digit -- page number - (guardDisabled Ext_fancy_lists >> - do many1 digit - char '.' - spaceChar - return (1, DefaultStyle, DefaultDelim)) - <|> do (num, style, delim) <- anyOrderedListMarker - -- if it could be an abbreviated first name, insist on more than one space - if delim == Period && (style == UpperAlpha || (style == UpperRoman && - num `elem` [1, 5, 10, 50, 100, 500, 1000])) - then char '\t' <|> (try $ char ' ' >> spaceChar) - else spaceChar - skipSpaces - return (num, style, delim) + res <- do guardDisabled Ext_fancy_lists + many1 digit + char '.' + return (1, DefaultStyle, DefaultDelim) + <|> do (num, style, delim) <- anyOrderedListMarker + -- if it could be an abbreviated first name, + -- insist on more than one space + when (delim == Period && (style == UpperAlpha || + (style == UpperRoman && + num `elem` [1, 5, 10, 50, 100, 500, 1000]))) $ + () <$ spaceChar + return (num, style, delim) + endpos <- sourceColumn <$> getPosition + tabStop <- getOption readerTabStop + lookAhead (newline <|> spaceChar) + atMostSpaces (tabStop - (endpos - startpos)) + return res listStart :: MarkdownParser () listStart = bulletListStart <|> (anyOrderedListStart >> return ()) --- parse a line of a list item (start = parser for beginning of list item) listLine :: MarkdownParser String listLine = try $ do notFollowedBy' (do indentSpaces @@ -753,19 +762,21 @@ listLine = try $ do listStart) notFollowedByHtmlCloser optional (() <$ indentSpaces) - chunks <- manyTill + listLineCommon + +listLineCommon :: MarkdownParser String +listLineCommon = concat <$> manyTill ( many1 (satisfy $ \c -> c /= '\n' && c /= '<') <|> liftM snd (htmlTag isCommentTag) <|> count 1 anyChar ) newline - return $ concat chunks -- parse raw text for one list item, excluding start marker and continuations rawListItem :: MarkdownParser a -> MarkdownParser String rawListItem start = try $ do start - first <- listLine + first <- listLineCommon rest <- many (notFollowedBy listStart >> notFollowedBy blankline >> listLine) blanks <- many blankline return $ unlines (first:rest) ++ blanks @@ -823,8 +834,14 @@ orderedList = try $ do items <- fmap sequence $ many1 $ listItem ( try $ do optional newline -- if preceded by Plain block in a list + startpos <- sourceColumn <$> getPosition skipNonindentSpaces - orderedListMarker style delim ) + res <- orderedListMarker style delim + endpos <- sourceColumn <$> getPosition + tabStop <- getOption readerTabStop + lookAhead (newline <|> spaceChar) + atMostSpaces (tabStop - (endpos - startpos)) + return res ) start' <- option 1 $ guardEnabled Ext_startnum >> return start return $ B.orderedListWith (start', style, delim) <$> fmap compactify' items diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 3b321cc19..bbca7f858 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -297,7 +297,7 @@ inlineToConTeXt (Link txt (('#' : ref), _)) = do <> brackets (text ref) inlineToConTeXt (Link txt (src, _)) = do - let isAutolink = txt == [Str src] + let isAutolink = txt == [Str (unEscapeString src)] st <- get let next = stNextRef st put $ st {stNextRef = next + 1} diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 36ce2ba21..9ead604d7 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -40,7 +40,7 @@ import Text.Pandoc.Slides import Text.Pandoc.Highlighting ( highlight, styleToCss, formatHtmlInline, formatHtmlBlock ) import Text.Pandoc.XML (fromEntities, escapeStringForXML) -import Network.URI ( parseURIReference, URI(..) ) +import Network.URI ( parseURIReference, URI(..), unEscapeString ) import Network.HTTP ( urlEncode ) import Numeric ( showHex ) import Data.Char ( ord, toLower ) @@ -361,13 +361,13 @@ obfuscateLink opts txt s = ReferenceObfuscation -> -- need to use preEscapedString or &'s are escaped to & in URL preEscapedString $ "<a href=\"" ++ (obfuscateString s') - ++ "\">" ++ (obfuscateString txt) ++ "</a>" + ++ "\" class=\"email\">" ++ (obfuscateString txt) ++ "</a>" JavascriptObfuscation -> (H.script ! A.type_ "text/javascript" $ preEscapedString ("\n<!--\nh='" ++ obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++ obfuscateString name' ++ "';e=n+a+h;\n" ++ - "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++ + "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail\">'+" ++ linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >> H.noscript (preEscapedString $ obfuscateString altText) _ -> error $ "Unknown obfuscation method: " ++ show meth @@ -739,9 +739,12 @@ inlineToHtml opts inline = RevealJsSlides -> '#':'/':xs _ -> s let link = H.a ! A.href (toValue s') $ linkText + let link' = if txt == [Str (unEscapeString s)] + then link ! A.class_ "uri" + else link return $ if null tit - then link - else link ! A.title (toValue tit) + then link' + else link' ! A.title (toValue tit) (Image txt (s,tit)) | treatAsImage s -> do let alternate' = stringify txt let attributes = [A.src $ toValue s] ++ diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 3ed20ae87..5e4966abb 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -793,12 +793,17 @@ inlineToLaTeX (Note contents) = do (CodeBlock _ _ : _) -> cr _ -> empty let noteContents = nest 2 contents' <> optnl + opts <- gets stOptions + -- in beamer slides, display footnote from current overlay forward + let beamerMark = if writerBeamer opts + then text "<.->" + else empty modify $ \st -> st{ stNotes = noteContents : stNotes st } return $ if inMinipage then "\\footnotemark{}" -- note: a \n before } needed when note ends with a Verbatim environment - else "\\footnote" <> braces noteContents + else "\\footnote" <> beamerMark <> braces noteContents protectCode :: [Inline] -> [Inline] protectCode [] = [] |