diff options
author | John MacFarlane <jgm@berkeley.edu> | 2020-04-18 12:06:41 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2020-04-18 12:06:41 -0700 |
commit | f0c6411ede11b6282f70a668aad434e1420303f1 (patch) | |
tree | 9bf1c6bf55bf835fcc268f5e767b6229b68a13b1 | |
parent | 37cadd5a025503b280b6328d523a57efea8c6256 (diff) | |
download | pandoc-f0c6411ede11b6282f70a668aad434e1420303f1.tar.gz |
Fix round-trip bug with HTML tables....
introduced by parsing of table attributes. (The writer
always added a style with width, and we would get multiple
such styles through successive round trips.)
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 77585e920..4d718bfa7 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -885,7 +885,7 @@ blockToHtml opts (DefinitionList lst) = do return $ mconcat $ nl opts : term' : nl opts : intersperse (nl opts) defs') lst defList opts contents -blockToHtml opts (Table _ blkCapt specs thead tbody tfoot) = do +blockToHtml opts (Table attr blkCapt specs thead tbody tfoot) = do let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot captionDoc <- if null capt then return mempty @@ -913,15 +913,19 @@ blockToHtml opts (Table _ blkCapt specs thead tbody tfoot) = do return $ H.thead (nl opts >> contents) >> nl opts body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $ zipWithM (tableRowToHtml opts aligns) [1..] rows' - let tbl = H.table $ - nl opts >> captionDoc >> coltags >> head' >> body' >> nl opts - let totalWidth = sum widths + let (ident,classes,kvs) = attr -- When widths of columns are < 100%, we need to set width for the whole - -- table, or some browsers give us skinny columns with lots of space between: - return $ if totalWidth == 0 || totalWidth == 1 - then tbl - else tbl ! A.style (toValue $ "width:" <> - show (round (totalWidth * 100) :: Int) <> "%;") + -- table, or some browsers give us skinny columns with lots of space + -- between: + let totalWidth = sum widths + let attr' = case lookup "style" kvs of + Nothing | totalWidth < 1 && totalWidth > 0 + -> (ident,classes, ("style","width:" <> + T.pack (show (round (totalWidth * 100) :: Int)) + <> "%;"):kvs) + _ -> attr + addAttrs opts attr' $ H.table $ + nl opts >> captionDoc >> coltags >> head' >> body' >> nl opts tableRowToHtml :: PandocMonad m => WriterOptions |