Merge pull request #1238 from tarleb/org-figures

Org reader: Add support for figures

src/Text/Pandoc/Readers/Org.hs

@@ -37,6 +37,7 @@ import           Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateL
 import           Text.Pandoc.Shared (compactify')
 
 import           Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
+import           Control.Arrow ((***))
 import           Control.Monad (guard, when)
 import           Data.Char (toLower)
 import           Data.Default
@@ -155,6 +156,7 @@ block = choice [ mempty <$ blanklines
                , orgBlock
                , example
                , drawer
+               , figure
                , specialLine
                , header
                , hline
@@ -249,6 +251,43 @@ drawerEnd = try $
   skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
 
 
+--
+-- Figures
+--
+
+-- Figures (Image on a line by itself, preceded by name and/or caption)
+figure :: OrgParser Blocks
+figure = try $ do
+  (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)
+                <$> nameAndOrCaption
+  src <- skipSpaces *> selfTarget <* skipSpaces <* newline
+  guard (isImageFilename src)
+  return . B.para $ B.image src tit cap
+ where withFigPrefix cs = if "fig:" `isPrefixOf` cs
+                          then cs
+                          else "fig:" ++ cs
+
+nameAndOrCaption :: OrgParser (Maybe String, Maybe Inlines)
+nameAndOrCaption = try $ nameFirst <|> captionFirst
+ where
+   nameFirst = try $ do
+                 n <- name
+                 c <- optionMaybe caption
+                 return (Just n, c)
+   captionFirst = try $ do
+                 c <- caption
+                 n <- optionMaybe name
+                 return (n, Just c)
+
+caption :: OrgParser Inlines
+caption = try $ annotation "CAPTION" *> inlinesTillNewline
+
+name :: OrgParser String
+name = try $ annotation "NAME" *> skipSpaces *> manyTill anyChar newline
+
+annotation :: String -> OrgParser String
+annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'
+
 -- Comments, Options and Metadata
 specialLine :: OrgParser Blocks
 specialLine = try $ metaLine <|> commentLine
@@ -274,7 +313,7 @@ declarationLine = try $ do
   return mempty
 
 metaValue :: OrgParser MetaValue
-metaValue = MetaInlines . B.toList . trimInlines <$> restOfLine
+metaValue = MetaInlines . B.toList <$> inlinesTillNewline
 
 metaKey :: OrgParser String
 metaKey = map toLower <$> many1 (noneOf ": \n\r")
@@ -285,7 +324,7 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")
 header :: OrgParser Blocks
 header = try $
   B.header <$> headerStart
-           <*> (trimInlines <$> restOfLine)
+           <*> inlinesTillNewline
 
 headerStart :: OrgParser Int
 headerStart = try $
@@ -421,13 +460,10 @@ setAligns aligns t = t{ orgTableAlignments = aligns }
 -- Paragraphs or Plain text
 paraOrPlain :: OrgParser Blocks
 paraOrPlain = try $
-  trimInlines . mconcat
-    <$> many1 inline
-    <**> option B.plain
-                (try $ newline *> pure B.para)
+  parseInlines <**> option B.plain (try $ newline *> pure B.para)
 
-restOfLine :: OrgParser Inlines
-restOfLine = mconcat <$> manyTill inline newline
+inlinesTillNewline :: OrgParser Inlines
+inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline
 
 
 --
@@ -520,6 +556,8 @@ inline =
          ] <* (guard =<< newlinesCountWithinLimits)
   <?> "inline"
 
+parseInlines :: OrgParser Inlines
+parseInlines = trimInlines . mconcat <$> many1 inline
 
 -- treat these as potentially non-text when parsing inline:
 specialChars :: [Char]
@@ -577,6 +615,9 @@ selflinkOrImage = try $ do
            then B.image src "" ""
            else B.link src "" (B.str src)
 
+selfTarget :: OrgParser String
+selfTarget = try $ char '[' *> linkTarget <* char ']'
+
 linkTarget :: OrgParser String
 linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")
 

tests/Tests/Readers/Org.hs

@@ -377,6 +377,27 @@ tests =
               code' = "main = putStrLn greeting\n" ++
                        "  where greeting = \"moin\"\n"
           in codeBlockWith attr' code'
+
+      , "Figure" =:
+          unlines [ "#+caption: A very courageous man."
+                  , "#+name: goodguy"
+                  , "[[edward.jpg]]"
+                  ] =?>
+          para (image "edward.jpg" "fig:goodguy" "A very courageous man.")
+
+      , "Unnamed figure" =:
+          unlines [ "#+caption: A great whistleblower."
+                  , "[[snowden.png]]"
+                  ] =?>
+          para (image "snowden.png" "" "A great whistleblower.")
+
+      , "Figure with `fig:` prefix in name" =:
+          unlines [ "#+caption: Used as a metapher in evolutionary biology."
+                  , "#+name: fig:redqueen"
+                  , "[[the-red-queen.jpg]]"
+                  ] =?>
+          para (image "the-red-queen.jpg" "fig:redqueen"
+                      "Used as a metapher in evolutionary biology.")
       ]
 
   , testGroup "Lists" $