Updated readers and writers for new image attribute parameter.

(mb21)

8 files changed, 103 insertions, 64 deletions

diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 51a35c8ad..9112979ab 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -115,5 +115,5 @@ addInline (Node _ STRONG nodes) =
 addInline (Node _ (LINK url title) nodes) =
   (Link (addInlines nodes) (unpack url, unpack title) :)
 addInline (Node _ (IMAGE url title) nodes) =
-  (Image (addInlines nodes) (unpack url, unpack title) :)
+  (Image nullAttr (addInlines nodes) (unpack url, unpack title) :)
 addInline _ = id
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 3cc2a4479..cbd50c252 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -633,11 +633,20 @@ addToStart toadd bs =
 -- A DocBook mediaobject is a wrapper around a set of alternative presentations
 getMediaobject :: Element -> DB Inlines
 getMediaobject e = do
-  imageUrl <- case filterChild (named "imageobject") e of
-                Nothing  -> return mempty
-                Just z   -> case filterChild (named "imagedata") z of
-                              Nothing -> return mempty
-                              Just i -> return $ attrValue "fileref" i
+  (imageUrl, attr) <-
+    case filterChild (named "imageobject") e of
+      Nothing  -> return (mempty, nullAttr)
+      Just z   -> case filterChild (named "imagedata") z of
+                    Nothing -> return (mempty, nullAttr)
+                    Just i  -> let atVal a = attrValue a i
+                                   w = case atVal "width" of
+                                         "" -> []
+                                         d  -> [("width", d)]
+                                   h = case atVal "depth" of
+                                         "" -> []
+                                         d  -> [("height", d)]
+                                   atr = (atVal "id", words $ atVal "role", w ++ h)
+                               in  return (atVal "fileref", atr)
   let getCaption el = case filterChild (\x -> named "caption" x
                                             || named "textobject" x
                                             || named "alt" x) el of
@@ -647,7 +656,7 @@ getMediaobject e = do
   let (caption, title) = if isNull figTitle
                             then (getCaption e, "")
                             else (return figTitle, "fig:")
-  liftM (image imageUrl title) caption
+  liftM (imageWith imageUrl title attr) caption
 
 getBlocks :: Element -> DB Blocks
 getBlocks e =  mconcat <$> (mapM parseBlock $ elContent e)
diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs
index 338540533..04edf4c6a 100644
--- a/src/Text/Pandoc/Readers/EPUB.hs
+++ b/src/Text/Pandoc/Readers/EPUB.hs
@@ -101,12 +101,12 @@ fetchImages mimes root arc (query iq -> links) =
           <$> findEntryByPath abslink arc
 
 iq :: Inline -> [FilePath]
-iq (Image _ (url, _)) = [url]
+iq (Image _ _ (url, _)) = [url]
 iq _ = []
 
 -- Remove relative paths
 renameImages :: FilePath -> Inline -> Inline
-renameImages root (Image a (url, b)) = Image a (collapseFilePath (root </> url), b)
+renameImages root (Image attr a (url, b)) = Image attr a (collapseFilePath (root </> url), b)
 renameImages _ x = x
 
 imageToPandoc :: FilePath -> Pandoc
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index fcba16e04..d0ee893f2 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -609,7 +609,13 @@ pImage = do
                  _               -> url'
   let title = fromAttrib "title" tag
   let alt = fromAttrib "alt" tag
-  return $ B.image (escapeURI url) title (B.text alt)
+  let uid = fromAttrib "id" tag
+  let cls = words $ fromAttrib "class" tag
+  let getAtt k = case fromAttrib k tag of
+                   "" -> []
+                   v  -> [(k, v)]
+  let kvs = concat $ map getAtt ["width", "height", "sizes", "srcset"]
+  return $ B.imageWith (escapeURI url) title (uid, cls, kvs) (B.text alt)
 
 pCode :: TagParser Inlines
 pCode = try $ do
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 0da912ea6..def429232 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -55,6 +55,7 @@ import Data.List (intercalate)
 import qualified Data.Map as M
 import qualified Control.Exception as E
 import Text.Pandoc.Highlighting (fromListingsLanguage)
+import Text.Pandoc.ImageSize (numUnit, showFl)
 import Text.Pandoc.Error
 
 -- | Parse LaTeX from string and return 'Pandoc' document.
@@ -391,7 +392,8 @@ inlineCommand = try $ do
   star <- option "" (string "*")
   let name' = name ++ star
   let raw = do
-        rawcommand <- getRawCommand name'
+        rawargs <- withRaw (skipopts *> option "" dimenarg *> many braced)
+        let rawcommand = '\\' : name ++ star ++ snd rawargs
         transformed <- applyMacros' rawcommand
         if transformed /= rawcommand
            then parseFromString inlines transformed
@@ -521,7 +523,9 @@ inlineCommands = M.fromList $
   , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
        tok >>= \lab ->
          pure (link url "" lab))
-  , ("includegraphics", skipopts *> (unescapeURL <$> braced) >>= mkImage)
+  , ("includegraphics", do options <- option [] keyvals
+                           src <- unescapeURL <$> braced
+                           mkImage options src)
   , ("enquote", enquote)
   , ("cite", citation "cite" AuthorInText False)
   , ("citep", citation "citep" NormalCitation False)
@@ -582,14 +586,19 @@ inlineCommands = M.fromList $
   -- in which case they will appear as raw latex blocks:
   [ "index" ]
 
-mkImage :: String -> LP Inlines
-mkImage src = do
+mkImage :: [(String, String)] -> String -> LP Inlines
+mkImage options src = do
+   let replaceTextwidth (k,v) = case numUnit v of
+                                  Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
+                                  _ -> (k, v)
+   let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
+   let attr = ("",[], kvs)
    let alt = str "image"
    case takeExtension src of
         "" -> do
               defaultExt <- getOption readerDefaultImageExtension
-              return $ image (addExtension src defaultExt) "" alt
-        _  -> return $ image src "" alt
+              return $ imageWith (addExtension src defaultExt) "" attr alt
+        _  -> return $ imageWith src "" attr alt
 
 inNote :: Inlines -> Inlines
 inNote ils =
@@ -970,7 +979,7 @@ readFileFromDirs (d:ds) f =
 keyval :: LP (String, String)
 keyval = try $ do
   key <- many1 alphaNum
-  val <- option "" $ char '=' >> many1 alphaNum
+  val <- option "" $ char '=' >> many1 (alphaNum <|> char '.' <|> char '\\')
   skipMany spaceChar
   optional (char ',')
   skipMany spaceChar
@@ -997,11 +1006,11 @@ rawLaTeXInline = do
 
 addImageCaption :: Blocks -> LP Blocks
 addImageCaption = walkM go
-  where go (Image alt (src,tit)) = do
+  where go (Image attr alt (src,tit)) = do
           mbcapt <- stateCaption <$> getState
           return $ case mbcapt of
-               Just ils -> Image (toList ils) (src, "fig:")
-               Nothing  -> Image alt (src,tit)
+               Just ils -> Image attr (toList ils) (src, "fig:")
+               Nothing  -> Image attr alt (src,tit)
         go x = return x
 
 addTableCaption :: Blocks -> LP Blocks
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index ea5f5326d..ebca7e83d 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -369,23 +369,26 @@ referenceKey = try $ do
   let sourceURL = liftM unwords $ many $ try $ do
                     skipMany spaceChar
                     notFollowedBy' referenceTitle
+                    notFollowedBy' $ guardEnabled Ext_common_link_attributes >> attributes
                     notFollowedBy' (() <$ reference)
                     many1 $ notFollowedBy space >> litChar
   let betweenAngles = try $ char '<' >> manyTill litChar (char '>')
   src <- try betweenAngles <|> sourceURL
   tit <- option "" referenceTitle
-  -- currently we just ignore MMD-style link/image attributes
-  _kvs <- option [] $ guardEnabled Ext_link_attributes
-                      >> many (try $ spnl >> keyValAttr)
+  attr   <- option nullAttr $ try $
+              guardEnabled Ext_common_link_attributes >> skipSpaces >> attributes
+  addKvs <- option [] $ guardEnabled Ext_link_attributes
+                          >> many (try $ spnl >> keyValAttr)
   blanklines
-  let target = (escapeURI $ trimr src,  tit)
+  let attr'  = extractIdClass $ foldl (\x f -> f x) attr addKvs
+      target = (escapeURI $ trimr src, tit)
   st <- getState
   let oldkeys = stateKeys st
   let key = toKey raw
   case M.lookup key oldkeys of
     Just _  -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"
     Nothing -> return ()
-  updateState $ \s -> s { stateKeys = M.insert key target oldkeys }
+  updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys }
   return $ return mempty
 
 referenceTitle :: MarkdownParser String
@@ -512,9 +515,9 @@ atxHeader = try $ do
   (text, raw) <- withRaw $
           trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline)
   attr <- atxClosing
-  attr'@(ident,_,_) <- registerHeader attr (runF text defaultParserState)
+  attr' <- registerHeader attr (runF text defaultParserState)
   guardDisabled Ext_implicit_header_references
-    <|> registerImplicitHeader raw ident
+    <|> registerImplicitHeader raw attr'
   return $ B.headerWith attr' level <$> text
 
 atxClosing :: MarkdownParser Attr
@@ -555,16 +558,16 @@ setextHeader = try $ do
   many (char underlineChar)
   blanklines
   let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1
-  attr'@(ident,_,_) <- registerHeader attr (runF text defaultParserState)
+  attr' <- registerHeader attr (runF text defaultParserState)
   guardDisabled Ext_implicit_header_references
-    <|> registerImplicitHeader raw ident
+    <|> registerImplicitHeader raw attr'
   return $ B.headerWith attr' level <$> text
 
-registerImplicitHeader :: String -> String -> MarkdownParser ()
-registerImplicitHeader raw ident = do
+registerImplicitHeader :: String -> Attr -> MarkdownParser ()
+registerImplicitHeader raw attr@(ident, _, _) = do
   let key = toKey $ "[" ++ raw ++ "]"
   updateState (\s -> s { stateHeaderKeys =
-                         M.insert key ('#':ident,"") (stateHeaderKeys s) })
+                         M.insert key (('#':ident,""), attr) (stateHeaderKeys s) })
 
 --
 -- hrule block
@@ -971,11 +974,11 @@ para = try $ do
             return $ do
               result' <- result
               case B.toList result' of
-                   [Image alt (src,tit)]
+                   [Image attr alt (src,tit)]
                      | Ext_implicit_figures `Set.member` exts ->
                         -- the fig: at beginning of title indicates a figure
                         return $ B.para $ B.singleton
-                               $ Image alt (src,'f':'i':'g':':':tit)
+                               $ Image attr alt (src,'f':'i':'g':':':tit)
                    _ -> return $ B.para result'
 
 plain :: MarkdownParser (F Blocks)
@@ -1700,16 +1703,18 @@ link = try $ do
   setState $ st{ stateAllowLinks = False }
   (lab,raw) <- reference
   setState $ st{ stateAllowLinks = True }
-  regLink B.link lab <|> referenceLink B.link (lab,raw)
+  regLink B.linkWith lab <|> referenceLink B.linkWith (lab,raw)
 
-regLink :: (String -> String -> Inlines -> Inlines)
+regLink :: (String -> String -> Attr -> Inlines -> Inlines)
         -> F Inlines -> MarkdownParser (F Inlines)
 regLink constructor lab = try $ do
   (src, tit) <- source
-  return $ constructor src tit <$> lab
+  attr <- option nullAttr $
+          guardEnabled Ext_common_link_attributes >> attributes
+  return $ constructor src tit attr <$> lab
 
 -- a link like [this][ref] or [this][] or [this]
-referenceLink :: (String -> String -> Inlines -> Inlines)
+referenceLink :: (String -> String -> Attr -> Inlines -> Inlines)
               -> (F Inlines, String) -> MarkdownParser (F Inlines)
 referenceLink constructor (lab, raw) = do
   sp <- (True <$ lookAhead (char ' ')) <|> return False
@@ -1721,7 +1726,7 @@ referenceLink constructor (lab, raw) = do
   let labIsRef = raw' == "" || raw' == "[]"
   let key = toKey $ if labIsRef then raw else raw'
   parsedRaw <- parseFromString (mconcat <$> many inline) raw'
-  fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw
+  fallback  <- parseFromString (mconcat <$> many inline) $ dropBrackets raw
   implicitHeaderRefs <- option False $
                          True <$ guardEnabled Ext_implicit_header_references
   let makeFallback = do
@@ -1738,10 +1743,10 @@ referenceLink constructor (lab, raw) = do
             then do
               headerKeys <- asksF stateHeaderKeys
               case M.lookup key headerKeys of
-                   Just (src, tit) -> constructor src tit <$> lab
-                   Nothing         -> makeFallback
+                   Just ((src, tit), _) -> constructor src tit nullAttr <$> lab
+                   Nothing              -> makeFallback
             else makeFallback
-       Just (src,tit) -> constructor src tit <$> lab
+       Just ((src,tit), attr) -> constructor src tit attr <$> lab
 
 dropBrackets :: String -> String
 dropBrackets = reverse . dropRB . reverse . dropLB
@@ -1776,8 +1781,8 @@ image = try $ do
   (lab,raw) <- reference
   defaultExt <- getOption readerDefaultImageExtension
   let constructor src = case takeExtension src of
-                              "" -> B.image (addExtension src defaultExt)
-                              _  -> B.image src
+                              "" -> B.imageWith (addExtension src defaultExt)
+                              _  -> B.imageWith src
   regLink constructor lab <|> referenceLink constructor (lab,raw)
 
 note :: MarkdownParser (F Inlines)
@@ -1913,7 +1918,7 @@ textualCite = try $ do
               spc | null spaces' = mempty
                   | otherwise    = B.space
           lab <- parseFromString (mconcat <$> many inline) $ dropBrackets raw'
-          fallback <- referenceLink B.link (lab,raw')
+          fallback <- referenceLink B.linkWith (lab,raw')
           return $ do
             fallback' <- fallback
             cs' <- cs
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index 2a5adab22..6f7da2586 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -577,21 +577,29 @@ image = try $ do
   sym "[["
   choice imageIdentifiers
   fname <- many1 (noneOf "|]")
-  _ <- many (try $ char '|' *> imageOption)
+  _ <- many imageOption
+  dims <- try (char '|' *> (sepBy (many digit) (char 'x')) <* string "px")
+          <|> return []
+  _ <- many imageOption
+  let kvs = case dims of
+              w:[]     -> [("width", w)]
+              w:(h:[]) -> [("width", w), ("height", h)]
+              _        -> []
+  let attr = ("", [], kvs)
   caption <-   (B.str fname <$ sym "]]")
            <|> try (char '|' *> (mconcat <$> manyTill inline (sym "]]")))
-  return $ B.image fname ("fig:" ++ stringify caption) caption
+  return $ B.imageWith fname ("fig:" ++ stringify caption) attr caption
 
 imageOption :: MWParser String
-imageOption =
-      try (oneOfStrings [ "border", "thumbnail", "frameless"
-                        , "thumb", "upright", "left", "right"
-                        , "center", "none", "baseline", "sub"
-                        , "super", "top", "text-top", "middle"
-                        , "bottom", "text-bottom" ])
-  <|> try (string "frame")
-  <|> try (many1 (oneOf "x0123456789") <* string "px")
-  <|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]"))
+imageOption = try $ char '|' *> opt
+  where
+    opt = try (oneOfStrings [ "border", "thumbnail", "frameless"
+                            , "thumb", "upright", "left", "right"
+                            , "center", "none", "baseline", "sub"
+                            , "super", "top", "text-top", "middle"
+                            , "bottom", "text-bottom" ])
+      <|> try (string "frame")
+      <|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]"))
 
 collapseUnderscores :: String -> String
 collapseUnderscores [] = []
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 678eecc52..8969c3176 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -812,9 +812,9 @@ substKey = try $ do
   res <- B.toList <$> directive'
   il <- case res of
              -- use alt unless :alt: attribute on image:
-             [Para [Image [Str "image"] (src,tit)]] ->
+             [Para [Image _ [Str "image"] (src,tit)]] ->
                 return $ B.image src tit alt
-             [Para [Link [Image [Str "image"] (src,tit)] (src',tit')]] ->
+             [Para [Link [Image _ [Str "image"] (src,tit)] (src',tit')]] ->
                 return $ B.link src' tit' (B.image src tit alt)
              [Para ils] -> return $ B.fromList ils
              _          -> mzero
@@ -827,7 +827,8 @@ anonymousKey = try $ do
   src <- targetURI
   pos <- getPosition
   let key = toKey $ "_" ++ printf "%09d" (sourceLine pos)
-  updateState $ \s -> s { stateKeys = M.insert key (src,"") $ stateKeys s }
+  --TODO: parse width, height, class and name attributes
+  updateState $ \s -> s { stateKeys = M.insert key ((src,""), nullAttr) $ stateKeys s }
 
 stripTicks :: String -> String
 stripTicks = reverse . stripTick . reverse . stripTick
@@ -841,7 +842,8 @@ regularKey = try $ do
   char ':'
   src <- targetURI
   let key = toKey $ stripTicks ref
-  updateState $ \s -> s { stateKeys = M.insert key (src,"") $ stateKeys s }
+  --TODO: parse width, height, class and name attributes
+  updateState $ \s -> s { stateKeys = M.insert key ((src,""), nullAttr) $ stateKeys s }
 
 --
 -- tables
@@ -1131,12 +1133,12 @@ referenceLink = try $ do
                    if null anonKeys
                       then mzero
                       else return (head anonKeys)
-  (src,tit) <- case M.lookup key keyTable of
-                    Nothing     -> fail "no corresponding key"
-                    Just target -> return target
+  ((src,tit), attr) <- case M.lookup key keyTable of
+                         Nothing  -> fail "no corresponding key"
+                         Just val -> return val
   -- if anonymous link, remove key so it won't be used again
   when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable }
-  return $ B.link src tit label'
+  return $ B.linkWith src tit attr label'
 
 autoURI :: RSTParser Inlines
 autoURI = do