From 56ceaf49dc1627ed05febcccae9899a68b3da99f Mon Sep 17 00:00:00 2001
From: Nils Carlson <nils@nilscarlson.se>
Date: Sat, 21 Nov 2020 00:05:56 +0000
Subject: [PATCH] DocBook reader: Table text width support (#6791)

Table width in relation to text width is not natively supported
by docbook but is by the docbook fo stylesheets through an XML
processing instruction, <?dbfo table-width="50%"?> .
Implement support for this instruction in the DocBook reader.
---
 src/Text/Pandoc/Readers/DocBook.hs | 14 +++++++++++--
 test/command/6791.md               | 32 ++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 2 deletions(-)
 create mode 100644 test/command/6791.md

diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 5ba48e704..b0846e345 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -960,12 +960,22 @@ parseBlock (Elem e) =
                       let aligns = case colspecs of
                                      [] -> replicate numrows AlignDefault
                                      cs -> map toAlignment cs
+                      let parseWidth s = safeRead (T.filter (\x -> (x >= '0' && x <= '9')
+                                                                   || x == '.') s)
+                      let textWidth = case filterChild (named "?dbfo") e of
+                                        Just d  -> case attrValue "table-width" d of
+                                                     "" -> 1.0
+                                                     w  -> fromMaybe 100.0 (parseWidth w) / 100.0
+                                        Nothing -> 1.0
                       let widths = case colspecs of
                                      [] -> replicate numrows ColWidthDefault
                                      cs -> let ws = map toWidth cs
                                            in case sequence ws of
-                                                Just ws' -> let tot = sum ws'
-                                                            in  ColWidth . (/ tot) <$> ws'
+                                                Just ws' -> let colTot = sum ws'
+                                                                scale
+                                                                  | textWidth == 1.0 = (/ colTot)
+                                                                  | otherwise = (* (textWidth / colTot) )
+                                                            in  ColWidth . scale <$> ws'
                                                 Nothing  -> replicate numrows ColWidthDefault
                       let toRow = Row nullAttr
                           toHeaderRow l = [toRow l | not (null l)]
diff --git a/test/command/6791.md b/test/command/6791.md
new file mode 100644
index 000000000..478647721
--- /dev/null
+++ b/test/command/6791.md
@@ -0,0 +1,32 @@
+```
+% pandoc -f docbook -t native --quiet
+<informaltable frame="all" rowsep="1" colsep="1">
+<?dbfo table-width="50%"?>
+<tgroup cols="2">
+<colspec colname="col_1" colwidth="6.25*"/>
+<colspec colname="col_2" colwidth="6.25*"/>
+<tbody>
+<row>
+<entry align="center" valign="top"><simpara>2</simpara></entry>
+<entry align="center" valign="top"><simpara>1</simpara></entry>
+</row>
+</tbody>
+</tgroup>
+</informaltable>
+^D
+[Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 0.25)
+ ,(AlignDefault,ColWidth 0.25)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+  []
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1)
+    [Para [Str "2"]]
+   ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1)
+    [Para [Str "1"]]]])]
+ (TableFoot ("",[],[])
+ [])]
+```