diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Readers/Org.hs | 37 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ICML.hs | 4 |
2 files changed, 34 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index fd714736a..980f63504 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -84,13 +84,21 @@ dropCommentTrees [] = [] dropCommentTrees blks@(b:bs) = maybe blks (flip dropUntilHeaderAboveLevel bs) $ commentHeaderLevel b --- | Return the level of a header starting a comment tree and Nothing --- otherwise. +-- | Return the level of a header starting a comment or :noexport: tree and +-- Nothing otherwise. commentHeaderLevel :: Block -> Maybe Int commentHeaderLevel blk = case blk of - (Header level _ ((Str "COMMENT"):_)) -> Just level - _ -> Nothing + (Header level _ ((Str "COMMENT"):_)) -> Just level + (Header level _ title) | hasNoExportTag title -> Just level + _ -> Nothing + where + hasNoExportTag :: [Inline] -> Bool + hasNoExportTag = any isNoExportTag + + isNoExportTag :: Inline -> Bool + isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True + isNoExportTag _ = False -- | Drop blocks until a header on or above the given level is seen dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block] @@ -657,8 +665,25 @@ parseFormat = try $ do header :: OrgParser (F Blocks) header = try $ do level <- headerStart - title <- inlinesTillNewline - return $ B.header level <$> title + title <- manyTill inline (lookAhead headerEnd) + tags <- headerEnd + let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags + return $ B.header level <$> inlns + where + tagToInlineF :: String -> F Inlines + tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + +headerEnd :: OrgParser [String] +headerEnd = option [] headerTags <* newline + +headerTags :: OrgParser [String] +headerTags = try $ + skipSpaces + *> char ':' + *> many1 tag + <* skipSpaces + where tag = many1 (alphaNum <|> oneOf "@%#_") + <* char ':' headerStart :: OrgParser Int headerStart = try $ diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 6af4b7aa3..f42d26614 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -25,6 +25,7 @@ import Data.List (isPrefixOf, isInfixOf, stripPrefix) import Data.Text as Text (breakOnAll, pack) import Data.Monoid (mappend) import Control.Monad.State +import Network.URI (isURI) import qualified Data.Set as Set type Style = [String] @@ -499,6 +500,7 @@ imageICML _ style _ (linkURI, _) = hh = show $ imgHeight `div` 2 qw = show $ imgWidth `div` 4 qh = show $ imgHeight `div` 4 + uriPrefix = if isURI linkURI then "" else "file:" (stlStr, attrs) = styleToStrAttr style props = inTags True "Properties" [] $ inTags True "PathGeometry" [] $ inTags True "GeometryPathType" [("PathOpen","false")] @@ -518,7 +520,7 @@ imageICML _ style _ (linkURI, _) = $ vcat [ inTags True "Properties" [] $ inTags True "Profile" [("type","string")] $ text "$ID/Embedded" $$ selfClosingTag "GraphicBounds" [("Left","0"), ("Top","0"), ("Right", hw), ("Bottom", hh)] - , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", linkURI)] + , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", uriPrefix++linkURI)] ] doc = inTags True "CharacterStyleRange" attrs $ inTags True "Rectangle" [("Self","uec"), ("ItemTransform", "1 0 0 1 "++qw++" -"++qh)] |