From f4a8f123878ca6ee1b58ff114494761459d43fdf Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Mon, 21 Nov 2016 21:51:06 +0100
Subject: Org reader: respect column width settings
Table column properties can optionally specify a column's width with
which it is displayed in the buffer. Some exporters, notably the ODT
exporter in org-mode v9.0, use these values to calculate relative column
widths. The org reader now implements the same behavior.
Note that the org-mode LaTeX and HTML exporters in Emacs don't support
this feature yet, which should be kept in mind by users who use the
column widths parameters.
Closes: #3246
---
src/Text/Pandoc/Readers/Org/BlockStarts.hs | 2 +-
src/Text/Pandoc/Readers/Org/Blocks.hs | 74 +++++++++++++++++++-----------
2 files changed, 48 insertions(+), 28 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Readers/Org/BlockStarts.hs b/src/Text/Pandoc/Readers/Org/BlockStarts.hs
index e068f9178..b1004dda6 100644
--- a/src/Text/Pandoc/Readers/Org/BlockStarts.hs
+++ b/src/Text/Pandoc/Readers/Org/BlockStarts.hs
@@ -116,7 +116,7 @@ noteMarker = try $ do
-- | Succeeds if the parser is at the end of a block.
endOfBlock :: OrgParser ()
endOfBlock = lookAhead . try $ do
- void blankline <|> anyBlockStart <|> void noteMarker
+ void blankline <|> anyBlockStart
where
-- Succeeds if there is a new block starting at this position.
anyBlockStart :: OrgParser ()
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 807cce2fc..c217949d8 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -46,10 +46,11 @@ import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder ( Inlines, Blocks )
import Text.Pandoc.Definition
import Text.Pandoc.Options
-import Text.Pandoc.Shared ( compactify', compactify'DL )
+import Text.Pandoc.Shared ( compactify', compactify'DL, safeRead )
import Control.Monad ( foldM, guard, mzero, void )
import Data.Char ( isSpace, toLower, toUpper)
+import Data.Default ( Default )
import Data.List ( foldl', isPrefixOf )
import Data.Maybe ( fromMaybe, isNothing )
import Data.Monoid ((<>))
@@ -687,18 +688,24 @@ commentLine = commentLineStart *> anyLine *> pure mempty
--
-- Tables
--
+data ColumnProperty = ColumnProperty
+ { columnAlignment :: Maybe Alignment
+ , columnRelWidth :: Maybe Int
+ } deriving (Show, Eq)
+
+instance Default ColumnProperty where
+ def = ColumnProperty Nothing Nothing
data OrgTableRow = OrgContentRow (F [Blocks])
- | OrgAlignRow [Alignment]
+ | OrgAlignRow [ColumnProperty]
| OrgHlineRow
-- OrgTable is strongly related to the pandoc table ADT. Using the same
-- (i.e. pandoc-global) ADT would mean that the reader would break if the
-- global structure was to be changed, which would be bad. The final table
--- should be generated using a builder function. Column widths aren't
--- implemented yet, so they are not tracked here.
+-- should be generated using a builder function.
data OrgTable = OrgTable
- { orgTableAlignments :: [Alignment]
+ { orgTableColumnProperties :: [ColumnProperty]
, orgTableHeader :: [Blocks]
, orgTableRows :: [[Blocks]]
}
@@ -715,8 +722,20 @@ table = try $ do
orgToPandocTable :: OrgTable
-> Inlines
-> Blocks
-orgToPandocTable (OrgTable aligns heads lns) caption =
- B.table caption (zip aligns $ repeat 0) heads lns
+orgToPandocTable (OrgTable colProps heads lns) caption =
+ let totalWidth = if any (not . isNothing) (map columnRelWidth colProps)
+ then Just . sum $ map (fromMaybe 1 . columnRelWidth) colProps
+ else Nothing
+ in B.table caption (map (convertColProp totalWidth) colProps) heads lns
+ where
+ convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, Double)
+ convertColProp totalWidth colProp =
+ let
+ align' = fromMaybe AlignDefault $ columnAlignment colProp
+ width' = fromMaybe 0 $ (\w t -> (fromIntegral w / fromIntegral t))
+ <$> (columnRelWidth colProp)
+ <*> totalWidth
+ in (align', width')
tableRows :: OrgParser [OrgTableRow]
tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
@@ -732,22 +751,22 @@ tableContentCell = try $
tableAlignRow :: OrgParser OrgTableRow
tableAlignRow = try $ do
tableStart
- cells <- many1Till tableAlignCell newline
+ colProps <- many1Till columnPropertyCell newline
-- Empty rows are regular (i.e. content) rows, not alignment rows.
- guard $ any (/= AlignDefault) cells
- return $ OrgAlignRow cells
-
-tableAlignCell :: OrgParser Alignment
-tableAlignCell =
- choice [ try $ emptyCell *> return AlignDefault
- , try $ skipSpaces
- *> char '<'
- *> tableAlignFromChar
- <* many digit
- <* char '>'
- <* emptyCell
- ] <?> "alignment info"
- where emptyCell = try $ skipSpaces *> endOfCell
+ guard $ any (/= def) colProps
+ return $ OrgAlignRow colProps
+
+columnPropertyCell :: OrgParser ColumnProperty
+columnPropertyCell = emptyCell <|> propCell <?> "alignment info"
+ where
+ emptyCell = ColumnProperty Nothing Nothing <$ (try $ skipSpaces *> endOfCell)
+ propCell = try $ ColumnProperty
+ <$> (skipSpaces
+ *> char '<'
+ *> optionMaybe tableAlignFromChar)
+ <*> (optionMaybe (many1 digit >>= safeRead)
+ <* char '>'
+ <* emptyCell)
tableAlignFromChar :: OrgParser Alignment
tableAlignFromChar = try $
@@ -769,7 +788,8 @@ rowsToTable = foldM rowToContent emptyTable
where emptyTable = OrgTable mempty mempty mempty
normalizeTable :: OrgTable -> OrgTable
-normalizeTable (OrgTable aligns heads rows) = OrgTable aligns' heads rows
+normalizeTable (OrgTable colProps heads rows) =
+ OrgTable colProps' heads rows
where
refRow = if heads /= mempty
then heads
@@ -778,7 +798,7 @@ normalizeTable (OrgTable aligns heads rows) = OrgTable aligns' heads rows
_ -> mempty
cols = length refRow
fillColumns base padding = take cols $ base ++ repeat padding
- aligns' = fillColumns aligns AlignDefault
+ colProps' = fillColumns colProps def
-- One or more horizontal rules after the first content line mark the previous
-- line as a header. All other horizontal lines are discarded.
@@ -788,7 +808,7 @@ rowToContent :: OrgTable
rowToContent orgTable row =
case row of
OrgHlineRow -> return singleRowPromotedToHeader
- OrgAlignRow as -> return . setAligns $ as
+ OrgAlignRow props -> return . setProperties $ props
OrgContentRow cs -> appendToBody cs
where
singleRowPromotedToHeader :: OrgTable
@@ -797,8 +817,8 @@ rowToContent orgTable row =
orgTable{ orgTableHeader = b , orgTableRows = [] }
_ -> orgTable
- setAligns :: [Alignment] -> OrgTable
- setAligns aligns = orgTable{ orgTableAlignments = aligns }
+ setProperties :: [ColumnProperty] -> OrgTable
+ setProperties ps = orgTable{ orgTableColumnProperties = ps }
appendToBody :: F [Blocks] -> F OrgTable
appendToBody frow = do
--
cgit v1.2.3