diff --git a/src/Text/Pandoc/Readers/RTF.hs b/src/Text/Pandoc/Readers/RTF.hs index fc805ac28..f3bc09df7 100644 --- a/src/Text/Pandoc/Readers/RTF.hs +++ b/src/Text/Pandoc/Readers/RTF.hs @@ -67,8 +67,7 @@ data RTFState = RTFState { sOptions :: ReaderOptions , sCharSet :: CharSet , sGroupStack :: [Properties] , sListStack :: [List] - , sCurrentCell :: Blocks - , sTableRows :: [TableRow] -- reverse order + , sTables :: IntMap.IntMap TableState , sTextContent :: [(Properties, Text)] , sMetadata :: [(Text, Inlines)] , sFontTable :: FontTable @@ -90,8 +89,7 @@ instance Default RTFState where , sCharSet = ANSI , sGroupStack = [] , sListStack = [] - , sCurrentCell = mempty - , sTableRows = [] + , sTables = mempty , sTextContent = [] , sMetadata = [] , sFontTable = mempty @@ -170,6 +168,7 @@ data Properties = , gListOverride :: Maybe Override , gListLevel :: Maybe Int , gInTable :: Bool + , gTableLevel :: Int } deriving (Show, Eq) instance Default Properties where @@ -192,6 +191,7 @@ instance Default Properties where , gListOverride = Nothing , gListLevel = Nothing , gInTable = False + , gTableLevel = 0 } type RTFParser m = ParsecT Sources RTFState m @@ -210,6 +210,17 @@ data List = newtype TableRow = TableRow [Blocks] -- cells in reverse order deriving (Show, Eq) +data TableState = TableState + { tableCurrentCell :: Blocks + , tableRows :: [TableRow] -- reverse order, current row first + } deriving (Show, Eq) + +emptyTableState :: TableState +emptyTableState = TableState + { tableCurrentCell = mempty + , tableRows = [] + } + parseRTF :: PandocMonad m => RTFParser m Pandoc parseRTF = do skipMany nl @@ -462,6 +473,8 @@ processTok bs (Tok pos tok') = do Tok _ (ControlWord "shppict" _) -> inGroup (foldM processTok bs toks) Tok _ (ControlWord "shpinst" _) -> inGroup (foldM processTok bs toks) Tok _ (ControlWord "pn" _) -> bs <$ handlePn toks + Tok _ (ControlWord "nesttableprops" _) -> + bs <$ inGroup (handleNestedTableProperties toks) _ -> bs <$ (do oldTextContent <- sTextContent <$> getState processTok mempty (Tok pos (Grouped toks)) updateState $ \st -> st{ sTextContent = oldTextContent }) @@ -538,6 +551,9 @@ processTok bs (Tok pos tok') = do return bs Grouped (Tok _ (ControlWord "info" _) : toks) -> bs <$ inGroup (processDestinationToks toks) + -- Fallback text for RTF readers which do not support nested tables. + -- Supporting readers must ignore this destination. + Grouped (Tok _ (ControlWord "nonesttables" _) : _) -> pure bs Grouped (Tok _ (ControlWord f _) : toks) | isMetadataField f -> inGroup $ do foldM_ processTok mempty toks annotatedToks <- reverse . sTextContent <$> getState @@ -584,26 +600,33 @@ processTok bs (Tok pos tok') = do modifyGroup (\g -> g{ gListOverride = mbp }) ControlWord "ilvl" mbp -> bs <$ modifyGroup (\g -> g{ gListLevel = mbp }) + ControlWord "itap" (Just level) -> do + let level' = max 0 level + bs' <- emitBlocks bs + closed <- closeTablesAbove level' + modifyGroup (\g -> g{ gInTable = level' > 0 + , gTableLevel = level' }) + pure $ bs' <> closed ControlSymbol '\\' -> bs <$ addText "\\" ControlSymbol '{' -> bs <$ addText "{" ControlSymbol '}' -> bs <$ addText "}" ControlSymbol '~' -> bs <$ addText "\x00a0" ControlSymbol '-' -> bs <$ addText "\x00ad" ControlSymbol '_' -> bs <$ addText "\x2011" - ControlWord "trowd" _ -> bs <$ beginTableRow -- begin new row - ControlWord "row" _ -> bs <$ beginTableRow -- end current row - ControlWord "cell" _ -> bs <$ do - new <- emitBlocks mempty - curCell <- (<> new) . sCurrentCell <$> getState - updateState $ \s -> s{ sTableRows = - case sTableRows s of - TableRow cs : rs -> - TableRow (curCell : cs) : rs - [] -> [TableRow [curCell]] -- shouldn't happen - , sCurrentCell = mempty } + ControlWord "trowd" _ -> bs <$ beginTableRow 1 -- begin top-level row + ControlWord "row" _ -> bs <$ beginTableRow 1 -- end top-level row + ControlWord "cell" _ -> bs <$ endTableCell 1 + ControlWord "nestcell" _ -> bs <$ do + level <- getTableLevel 2 + endTableCell level + ControlWord "nestrow" _ -> bs <$ do + level <- getTableLevel 2 + beginTableRow level ControlWord "intbl" _ -> do ls <- closeLists 0 -- see #11364 - ((ls <>) <$> emitBlocks bs) <* modifyGroup (\g -> g{ gInTable = True }) + ((ls <>) <$> emitBlocks bs) <* + modifyGroup (\g -> g{ gInTable = True + , gTableLevel = max 1 (gTableLevel g) }) ControlWord "plain" _ -> bs <$ modifyGroup resetCharProps ControlWord "lquote" _ -> bs <$ addText "\x2018" ControlWord "rquote" _ -> bs <$ addText "\x2019" @@ -719,37 +742,112 @@ closeLists lvl = do closeLists lvl _ -> pure mempty --- Begin a new table row. Both @\\trowd@ (which sets row defaults) and --- @\\row@ (which ends a row) start a fresh row to be filled by subsequent --- @\\cell@s. We only push a new empty row when the current one already has --- cells, so that documents repeating @\\trowd@ after @\\row@ (or omitting --- @\\trowd@ between rows) both produce the same flat structure. -beginTableRow :: PandocMonad m => RTFParser m () -beginTableRow = - updateState $ \s -> - s{ sTableRows = case sTableRows s of - TableRow [] : _ -> sTableRows s - rs -> TableRow [] : rs - , sCurrentCell = mempty } +-- Return the current paragraph's table nesting level. Nested-table control +-- words should never occur without @\\itapN@, but the supplied default lets us +-- handle malformed input without accidentally modifying the top-level table. +getTableLevel :: PandocMonad m => Int -> RTFParser m Int +getTableLevel fallback = do + groups <- sGroupStack <$> getState + pure $ case groups of + g : _ | gTableLevel g > 0 -> gTableLevel g + _ -> fallback -closeTable :: PandocMonad m => RTFParser m Blocks -closeTable = do - rawrows <- sTableRows <$> getState - if null rawrows - then return mempty - else do - let getCells (TableRow cs) = reverse cs - -- drop empty rows produced by row terminators - let rows = filter (not . null) . map getCells . reverse $ rawrows - updateState $ \s -> s{ sCurrentCell = mempty - , sTableRows = [] } - if null rows - then return mempty - else return $ B.simpleTable [] rows +modifyTable :: PandocMonad m + => Int + -> (TableState -> TableState) + -> RTFParser m () +modifyTable level f = + updateState $ \s -> + s{ sTables = IntMap.alter + (Just . f . fromMaybe emptyTableState) + level + (sTables s) } + +appendToTableCell :: PandocMonad m => Int -> Blocks -> RTFParser m () +appendToTableCell level blocks = + modifyTable level $ \tbl -> + tbl{ tableCurrentCell = tableCurrentCell tbl <> blocks } + +-- Begin a new table row. Both @\\trowd@ (which sets row defaults) and +-- @\\row@/@\\nestrow@ (which end a row) start a fresh row to be filled by +-- subsequent cells. Only push a new empty row when the current one already +-- has cells, so repeated row definitions do not create blank rows. +beginTableRow :: PandocMonad m => Int -> RTFParser m () +beginTableRow level = + modifyTable level $ \tbl -> + tbl{ tableRows = case tableRows tbl of + TableRow [] : _ -> tableRows tbl + rs -> TableRow [] : rs + , tableCurrentCell = mempty } + +-- Close all tables deeper than the given level. Each completed nested table +-- becomes a block in the current cell of the nearest active enclosing level. +-- Some real-world RTF jumps directly from (for example) @\\itap3@ to +-- @\\itap5@, so the numeric predecessor is not necessarily the parent. +closeTablesAbove :: PandocMonad m => Int -> RTFParser m Blocks +closeTablesAbove target = do + tables <- sTables <$> getState + case IntMap.lookupMax tables of + Just (level, _) | level > target -> do + mbTable <- closeTable level + remaining <- sTables <$> getState + let mbParent = + case IntMap.lookupMax remaining of + Just (parent, _) | parent >= target -> Just parent + _ | target > 0 -> Just target + | otherwise -> Nothing + here <- case mbTable of + Nothing -> pure mempty + Just table -> case mbParent of + Just parent -> mempty <$ appendToTableCell parent table + Nothing -> pure table + rest <- closeTablesAbove target + pure $ here <> rest + _ -> pure mempty + +closeTable :: PandocMonad m => Int -> RTFParser m (Maybe Blocks) +closeTable level = do + mbTable <- IntMap.lookup level . sTables <$> getState + updateState $ \s -> s{ sTables = IntMap.delete level (sTables s) } + case mbTable of + Nothing -> pure Nothing + Just tbl -> do + let getCells (TableRow cs) = reverse cs + -- Drop empty rows produced by row terminators. + let rows = filter (not . null) . map getCells . reverse $ + tableRows tbl + pure $ if null rows + then Nothing + else Just $ B.simpleTable [] rows + +endTableCell :: PandocMonad m => Int -> RTFParser m () +endTableCell level = do + -- Flush pending paragraph text first. emitBlocks appends it to the table + -- level recorded on the paragraph properties. + void $ emitBlocks mempty + -- A parent cell may end immediately after a nested row, without another + -- explicit @\\itap@ transition back to the parent. + void $ closeTablesAbove level + modifyTable level $ \tbl -> + let cell = tableCurrentCell tbl + in tbl{ tableRows = + case tableRows tbl of + TableRow cells : rows -> TableRow (cell : cells) : rows + [] -> [TableRow [cell]] + , tableCurrentCell = mempty } + +handleNestedTableProperties :: PandocMonad m => [Tok] -> RTFParser m () +handleNestedTableProperties toks = + when (any isNestedRowEnd toks) $ do + level <- getTableLevel 2 + beginTableRow level + where + isNestedRowEnd (Tok _ (ControlWord "nestrow" _)) = True + isNestedRowEnd _ = False closeContainers :: PandocMonad m => RTFParser m Blocks closeContainers = do - tbl <- closeTable + tbl <- closeTablesAbove 0 lists <- closeLists 0 return $ tbl <> lists @@ -773,7 +871,7 @@ emitBlocks bs = do ((p,_):_) -> p tbl <- if gInTable prop || null annotatedToks then pure mempty - else closeTable + else closeTablesAbove 0 new <- case annotatedToks of [] -> pure mempty @@ -838,7 +936,7 @@ emitBlocks bs = do $ map addFormatting annotatedToks) if gInTable prop then do - updateState $ \s -> s{ sCurrentCell = sCurrentCell s <> new } + appendToTableCell (max 1 $ gTableLevel prop) new pure bs else do pure $ bs <> tbl <> new diff --git a/test/Tests/Readers/RTF.hs b/test/Tests/Readers/RTF.hs index 82c0c735f..c656bab19 100644 --- a/test/Tests/Readers/RTF.hs +++ b/test/Tests/Readers/RTF.hs @@ -40,4 +40,6 @@ tests = map rtfTest [ "footnote" , "bookmark" , "table_simple" , "table_error_codes" + , "table_nested" + , "table_nested_malformed_itap" ] diff --git a/test/rtf/table_nested.native b/test/rtf/table_nested.native new file mode 100644 index 000000000..06c6698a4 --- /dev/null +++ b/test/rtf/table_nested.native @@ -0,0 +1,129 @@ +Pandoc + Meta { unMeta = fromList [] } + [ Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault , ColWidthDefault ) ] + (TableHead ( "" , [] , [] ) []) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault , ColWidthDefault ) ] + (TableHead ( "" , [] , [] ) []) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Level" + , Space + , Str "two" + , Space + , Str "before" + ] + , Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault + , ColWidthDefault + ) + , ( AlignDefault + , ColWidthDefault + ) + ] + (TableHead ( "" , [] , [] ) []) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Deep" + , Space + , Str "A" + ] + ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Deep" + , Space + , Str "B" + ] + ] + ] + , Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Deep" + , Space + , Str "C" + ] + ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Deep" + , Space + , Str "D" + ] + ] + ] + ] + ] + (TableFoot ( "" , [] , [] ) []) + , Para + [ Str "Level" + , Space + , Str "two" + , Space + , Str "after" + ] + ] + ] + ] + ] + (TableFoot ( "" , [] , [] ) []) + , Para [ Str "Outer" , Space , Str "after" ] + ] + ] + ] + ] + (TableFoot ( "" , [] , [] ) []) + , Para [ Str "Outside" , Space , Str "table" ] + ] diff --git a/test/rtf/table_nested.rtf b/test/rtf/table_nested.rtf new file mode 100644 index 000000000..2ecd256d2 --- /dev/null +++ b/test/rtf/table_nested.rtf @@ -0,0 +1,16 @@ +{\rtf1\ansi +\trowd\cellx5000 +\pard\intbl\itap2 Level two before\par +\pard\intbl\itap3 Deep A\nestcell Deep B\nestcell +{\*\nesttableprops\trowd\cellx2000\cellx4000\nestrow} +{\nonesttables NESTED FALLBACK ONE\par} +\pard\intbl\itap3 Deep C\nestcell Deep D\nestcell +{\*\nesttableprops\trowd\cellx2000\cellx4000\nestrow} +{\nonesttables NESTED FALLBACK TWO\par} +\pard\intbl\itap2 Level two after\nestcell +{\*\nesttableprops\trowd\cellx4000\nestrow} +{\nonesttables PARENT FALLBACK\par} +\pard\intbl\itap1 Outer after\cell +\row +\pard\itap0 Outside table\par +} diff --git a/test/rtf/table_nested_malformed_itap.native b/test/rtf/table_nested_malformed_itap.native new file mode 100644 index 000000000..6f465e201 --- /dev/null +++ b/test/rtf/table_nested_malformed_itap.native @@ -0,0 +1,89 @@ +Pandoc + Meta { unMeta = fromList [] } + [ Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault , ColWidthDefault ) ] + (TableHead ( "" , [] , [] ) []) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault , ColWidthDefault ) ] + (TableHead ( "" , [] , [] ) []) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Parent" + , Space + , Str "before" + ] + , Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault + , ColWidthDefault + ) + ] + (TableHead ( "" , [] , [] ) []) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Para + [ Str "Child" + , Space + , Str "at" + , Space + , Str "skipped" + , Space + , Str "level" + ] + ] + ] + ] + ] + (TableFoot ( "" , [] , [] ) []) + , Para + [ Str "Parent" + , Space + , Str "after" + ] + ] + ] + ] + ] + (TableFoot ( "" , [] , [] ) []) + , Para [ Str "Outer" , Space , Str "cell" ] + ] + ] + ] + ] + (TableFoot ( "" , [] , [] ) []) + ] diff --git a/test/rtf/table_nested_malformed_itap.rtf b/test/rtf/table_nested_malformed_itap.rtf new file mode 100644 index 000000000..5714bf1e3 --- /dev/null +++ b/test/rtf/table_nested_malformed_itap.rtf @@ -0,0 +1,10 @@ +{\rtf1\ansi +\trowd\cellx5000 +\pard\intbl\itap2 Parent before\par +\pard\intbl\itap5 Child at skipped level\nestcell +{\*\nesttableprops\trowd\cellx4000\nestrow} +\pard\intbl\itap2 Parent after\nestcell +{\*\nesttableprops\trowd\cellx4000\nestrow} +\pard\intbl\itap1 Outer cell\cell +\row +}