HTML reader: support column alignments.
These can be set either with a `width` attribute or with `text-width` in a `style` attribute. Closes #1881.
This commit is contained in:
John MacFarlane
parent
b9b35059f6
commit
b1f6fb4af5
3 changed files with 83 additions and 13 deletions
|
|
@ -301,6 +301,7 @@ Library
|
|||
HTTP >= 4000.0.5 && < 4000.4,
|
||||
texmath >= 0.9.4.1 && < 0.10,
|
||||
xml >= 1.3.12 && < 1.4,
|
||||
split >= 0.2 && < 0.3,
|
||||
random >= 1 && < 1.2,
|
||||
pandoc-types >= 1.17 && < 1.18,
|
||||
aeson >= 0.7 && < 1.3,
|
||||
|
|
|
|||
|
|
@ -55,9 +55,10 @@ import Text.Pandoc.Walk
|
|||
import qualified Data.Map as M
|
||||
import Data.Foldable ( for_ )
|
||||
import Data.Maybe ( fromMaybe, isJust, isNothing )
|
||||
import Data.List.Split ( wordsBy )
|
||||
import Data.List ( intercalate, isPrefixOf )
|
||||
import Data.Char ( isDigit, isLetter, isAlphaNum )
|
||||
import Control.Monad ( guard, mzero, void, unless )
|
||||
import Control.Monad ( guard, mzero, void, unless, mplus )
|
||||
import Control.Arrow ((***))
|
||||
import Control.Applicative ( (<|>) )
|
||||
import Data.Monoid (First (..))
|
||||
|
|
@ -472,31 +473,35 @@ pTable = try $ do
|
|||
caption <- option mempty $ pInTags "caption" inline <* skipMany pBlank
|
||||
widths' <- (mconcat <$> many1 pColgroup) <|> many pCol
|
||||
let pTh = option [] $ pInTags "tr" (pCell "th")
|
||||
pTr = try $ skipMany pBlank >> pInTags "tr" (pCell "td" <|> pCell "th")
|
||||
pTr = try $ skipMany pBlank >>
|
||||
pInTags "tr" (pCell "td" <|> pCell "th")
|
||||
pTBody = do pOptInTag "tbody" $ many1 pTr
|
||||
head'' <- pOptInTag "thead" pTh
|
||||
head' <- pOptInTag "tbody" $ do
|
||||
if null head''
|
||||
then pTh
|
||||
else return head''
|
||||
head' <- map snd <$>
|
||||
(pOptInTag "tbody" $
|
||||
if null head'' then pTh else return head'')
|
||||
rowsLs <- many pTBody
|
||||
rows' <- pOptInTag "tfoot" $ many pTr
|
||||
TagClose _ <- pSatisfy (matchTagClose "table")
|
||||
let rows'' = (concat rowsLs) <> rows'
|
||||
let rows''' = map (map snd) rows''
|
||||
-- let rows''' = map (map snd) rows''
|
||||
-- fail on empty table
|
||||
guard $ not $ null head' && null rows''
|
||||
guard $ not $ null head' && null rows'''
|
||||
let isSinglePlain x = case B.toList x of
|
||||
[] -> True
|
||||
[Plain _] -> True
|
||||
_ -> False
|
||||
let isSimple = all isSinglePlain $ concat (head':rows'')
|
||||
let cols = length $ if null head' then head rows'' else head'
|
||||
let isSimple = all isSinglePlain $ concat (head':rows''')
|
||||
let cols = length $ if null head' then head rows''' else head'
|
||||
-- add empty cells to short rows
|
||||
let addEmpties r = case cols - length r of
|
||||
n | n > 0 -> r <> replicate n mempty
|
||||
| otherwise -> r
|
||||
let rows = map addEmpties rows''
|
||||
let aligns = replicate cols AlignDefault
|
||||
let rows = map addEmpties rows'''
|
||||
let aligns = case rows'' of
|
||||
(cs:_) -> map fst cs
|
||||
_ -> replicate cols AlignDefault
|
||||
let widths = if null widths'
|
||||
then if isSimple
|
||||
then replicate cols 0
|
||||
|
|
@ -534,12 +539,24 @@ noColOrRowSpans t = isNullOrOne "colspan" && isNullOrOne "rowspan"
|
|||
"1" -> True
|
||||
_ -> False
|
||||
|
||||
pCell :: PandocMonad m => Text -> TagParser m [Blocks]
|
||||
pCell :: PandocMonad m => Text -> TagParser m [(Alignment, Blocks)]
|
||||
pCell celltype = try $ do
|
||||
skipMany pBlank
|
||||
tag <- lookAhead $
|
||||
pSatisfy (\t -> t ~== TagOpen celltype [] && noColOrRowSpans t)
|
||||
let extractAlign' [] = ""
|
||||
extractAlign' ("text-align":x:_) = x
|
||||
extractAlign' (_:xs) = extractAlign' xs
|
||||
let extractAlign = extractAlign' . wordsBy (`elem` [' ','\t',';',':'])
|
||||
let align = case maybeFromAttrib "align" tag `mplus`
|
||||
(extractAlign <$> maybeFromAttrib "style" tag) of
|
||||
Just "left" -> AlignLeft
|
||||
Just "right" -> AlignRight
|
||||
Just "center" -> AlignCenter
|
||||
_ -> AlignDefault
|
||||
res <- pInTags' celltype noColOrRowSpans block
|
||||
skipMany pBlank
|
||||
return [res]
|
||||
return [(align, res)]
|
||||
|
||||
pBlockQuote :: PandocMonad m => TagParser m Blocks
|
||||
pBlockQuote = do
|
||||
|
|
|
|||
52
test/command/1881.md
Normal file
52
test/command/1881.md
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
```
|
||||
% pandoc -f html -t native
|
||||
<table>
|
||||
<caption>Demonstration of simple table syntax.</caption>
|
||||
<thead>
|
||||
<tr class="header">
|
||||
<th align="right">Right</th>
|
||||
<th align="left">Left</th>
|
||||
<th align="center">Center</th>
|
||||
<th>Default</th>
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody>
|
||||
<tr class="odd">
|
||||
<td align="right">12</td>
|
||||
<td align="left">12</td>
|
||||
<td align="center">12</td>
|
||||
<td>12</td>
|
||||
</tr>
|
||||
</tbody>
|
||||
</table>
|
||||
^D
|
||||
[Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignRight,AlignLeft,AlignCenter,AlignDefault] [0.0,0.0,0.0,0.0]
|
||||
[[Plain [Str "Right"]]
|
||||
,[Plain [Str "Left"]]
|
||||
,[Plain [Str "Center"]]
|
||||
,[Plain [Str "Default"]]]
|
||||
[[[Plain [Str "12"]]
|
||||
,[Plain [Str "12"]]
|
||||
,[Plain [Str "12"]]
|
||||
,[Plain [Str "12"]]]]]
|
||||
```
|
||||
|
||||
```
|
||||
% pandoc -f html -t native
|
||||
<table>
|
||||
<tr class="odd">
|
||||
<td style="text-align: right;">12</td>
|
||||
<td style="text-align:left;">12</td>
|
||||
<td style="text-align: center">12</td>
|
||||
<td style="text-align: right;">12</td>
|
||||
</tr>
|
||||
</table>
|
||||
^D
|
||||
[Table [] [AlignRight,AlignLeft,AlignCenter,AlignRight] [0.0,0.0,0.0,0.0]
|
||||
[]
|
||||
[[[Plain [Str "12"]]
|
||||
,[Plain [Str "12"]]
|
||||
,[Plain [Str "12"]]
|
||||
,[Plain [Str "12"]]]]]
|
||||
```
|
||||
|
||||
Loading…
Add table
Reference in a new issue