From f4a8f123878ca6ee1b58ff114494761459d43fdf Mon Sep 17 00:00:00 2001 From: Albert Krewinkel 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