git.iko.soy/typeable/pandoc
on master help sign in
Org reader: support figure labels
0f3f5ceAlbert Krewinkel
src/Text/Pandoc/Readers/Org/Blocks.hs+6−1
@@ -98,6 +98,7 @@ block = choice [ mempty <$ blanklines
98-- | Attributes that may be added to figures (like a name or caption).
98-- | Attributes that may be added to figures (like a name or caption).
99data BlockAttributes = BlockAttributes
99data BlockAttributes = BlockAttributes
100 { blockAttrName :: Maybe String
100 { blockAttrName :: Maybe String
101+ , blockAttrLabel :: Maybe String
101 , blockAttrCaption :: Maybe (F Inlines)
102 , blockAttrCaption :: Maybe (F Inlines)
102 , blockAttrKeyValues :: [(String, String)]
103 , blockAttrKeyValues :: [(String, String)]
103 }
104 }
@@ -117,12 +118,14 @@ blockAttributes = try $ do
117 let caption = foldl' (appendValues "CAPTION") Nothing kv
118 let caption = foldl' (appendValues "CAPTION") Nothing kv
118 let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
119 let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
119 let name = lookup "NAME" kv
120 let name = lookup "NAME" kv
121+ let label = lookup "LABEL" kv
120 caption' <- maybe (return Nothing)
122 caption' <- maybe (return Nothing)
121 (fmap Just . parseFromString inlines)
123 (fmap Just . parseFromString inlines)
122 caption
124 caption
123 kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs
125 kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs
124 return $ BlockAttributes
126 return $ BlockAttributes
125 { blockAttrName = name
127 { blockAttrName = name
128+ , blockAttrLabel = label
126 , blockAttrCaption = caption'
129 , blockAttrCaption = caption'
127 , blockAttrKeyValues = kvAttrs'
130 , blockAttrKeyValues = kvAttrs'
128 }
131 }
@@ -131,6 +134,7 @@ blockAttributes = try $ do
131 attrCheck attr =
134 attrCheck attr =
132 case attr of
135 case attr of
133 "NAME" -> True
136 "NAME" -> True
137+ "LABEL" -> True
134 "CAPTION" -> True
138 "CAPTION" -> True
135 "ATTR_HTML" -> True
139 "ATTR_HTML" -> True
136 _ -> False
140 _ -> False
@@ -415,9 +419,10 @@ figure = try $ do
415 guard . not . isNothing . blockAttrCaption $ figAttrs
419 guard . not . isNothing . blockAttrCaption $ figAttrs
416 guard (isImageFilename src)
420 guard (isImageFilename src)
417 let figName = fromMaybe mempty $ blockAttrName figAttrs
421 let figName = fromMaybe mempty $ blockAttrName figAttrs
422+ let figLabel = fromMaybe mempty $ blockAttrLabel figAttrs
418 let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs
423 let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs
419 let figKeyVals = blockAttrKeyValues figAttrs
424 let figKeyVals = blockAttrKeyValues figAttrs
420− let attr = (mempty, mempty, figKeyVals)
425+ let attr = (figLabel, mempty, figKeyVals)
421 return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)
426 return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)
422 where
427 where
423 withFigPrefix :: String -> String
428 withFigPrefix :: String -> String
tests/Tests/Readers/Org.hs+41−31
@@ -767,37 +767,47 @@ tests =
767 , "#+END_COMMENT"] =?>
767 , "#+END_COMMENT"] =?>
768 (mempty::Blocks)
768 (mempty::Blocks)
769
769
770+ , testGroup "Figures" $
770− , "Figure" =:
771+ [ "Figure" =:
771− unlines [ "#+caption: A very courageous man."
772+ unlines [ "#+caption: A very courageous man."
772− , "#+name: goodguy"
773+ , "#+name: goodguy"
773− , "[[edward.jpg]]"
774+ , "[[edward.jpg]]"
774− ] =?>
775+ ] =?>
775− para (image "edward.jpg" "fig:goodguy" "A very courageous man.")
776+ para (image "edward.jpg" "fig:goodguy" "A very courageous man.")
776−
777+
777− , "Figure with no name" =:
778+ , "Figure with no name" =:
778− unlines [ "#+caption: I've been through the desert on this"
779+ unlines [ "#+caption: I've been through the desert on this"
779− , "[[horse.png]]"
780+ , "[[horse.png]]"
780− ] =?>
781+ ] =?>
781− para (image "horse.png" "fig:" "I've been through the desert on this")
782+ para (image "horse.png" "fig:" "I've been through the desert on this")
782−
783+
783− , "Figure with `fig:` prefix in name" =:
784+ , "Figure with `fig:` prefix in name" =:
784− unlines [ "#+caption: Used as a metapher in evolutionary biology."
785+ unlines [ "#+caption: Used as a metapher in evolutionary biology."
785− , "#+name: fig:redqueen"
786+ , "#+name: fig:redqueen"
786− , "[[the-red-queen.jpg]]"
787+ , "[[the-red-queen.jpg]]"
787− ] =?>
788+ ] =?>
788− para (image "the-red-queen.jpg" "fig:redqueen"
789+ para (image "the-red-queen.jpg" "fig:redqueen"
789− "Used as a metapher in evolutionary biology.")
790+ "Used as a metapher in evolutionary biology.")
790−
791+
791− , "Figure with HTML attributes" =:
792+ , "Figure with HTML attributes" =:
792− unlines [ "#+CAPTION: mah brain just explodid"
793+ unlines [ "#+CAPTION: mah brain just explodid"
793− , "#+NAME: lambdacat"
794+ , "#+NAME: lambdacat"
794− , "#+ATTR_HTML: :style color: blue :role button"
795+ , "#+ATTR_HTML: :style color: blue :role button"
795− , "[[lambdacat.jpg]]"
796+ , "[[lambdacat.jpg]]"
796− ] =?>
797+ ] =?>
797− let kv = [("style", "color: blue"), ("role", "button")]
798+ let kv = [("style", "color: blue"), ("role", "button")]
798− name = "fig:lambdacat"
799+ name = "fig:lambdacat"
799− caption = "mah brain just explodid"
800+ caption = "mah brain just explodid"
800− in para (imageWith (mempty, mempty, kv) "lambdacat.jpg" name caption)
801+ in para (imageWith (mempty, mempty, kv) "lambdacat.jpg" name caption)
802+
803+ , "Labelled figure" =:
804+ unlines [ "#+CAPTION: My figure"
805+ , "#+LABEL: fig:myfig"
806+ , "[[blub.png]]"
807+ ] =?>
808+ let attr = ("fig:myfig", mempty, mempty)
809+ in para (imageWith attr "blub.png" "fig:" "My figure")
810+ ]
801
811
802 , "Footnote" =:
812 , "Footnote" =:
803 unlines [ "A footnote[1]"
813 unlines [ "A footnote[1]"