JATS writer: support advanced table features

This commit is contained in:
Albert Krewinkel 2020-11-17 17:18:15 +01:00 committed by Albert Krewinkel
parent 0c8ab8a12f
commit d286242131
10 changed files with 776 additions and 380 deletions

View file

@ -10,6 +10,9 @@ on:
- 'test/writer.jats_publishing'
- 'test/writer.jats_archiving'
- 'test/tables.jats_archiving'
- 'test/tables/nordics.jats_archiving'
- 'test/tables/planets.jats_archiving'
- 'test/tables/students.jats_archiving'
pull_request:
branches:
- '*'
@ -19,6 +22,9 @@ on:
- 'test/writer.jats_publishing'
- 'test/writer.jats_archiving'
- 'test/tables.jats_archiving'
- 'test/tables/nordics.jats_archiving'
- 'test/tables/planets.jats_archiving'
- 'test/tables/students.jats_archiving'
jobs:
jats:
@ -65,13 +71,18 @@ jobs:
EOF
)"
jats_file="$(mktemp jats-tables.XXXXX)"
printf "$tmpl" "$(cat test/tables.jats_archiving)" > "$jats_file"
json="$(curl --form "xml=@${jats_file}" --silent "$VALIDATOR_URL")"
err_count="$(printf "%s" "$json" | jq '.errors | length')"
if [ "$err_count" -eq 0 ]; then
printf "Table output is valid when used as body content.\n"
exit 0
else
printf "Validator report:\n%s" "$json"
exit 1
fi
exit_code=0
for f in tables tables/nordics tables/planets tables/students; do
filename=test/$f.jats_archiving
printf "Validating %s...\n" "$filename"
printf "$tmpl" "$(cat $filename)" > "$jats_file"
json="$(curl --form "xml=@${jats_file}" --silent "$VALIDATOR_URL")"
err_count="$(printf "%s" "$json" | jq '.errors | length')"
if [ "$err_count" -eq 0 ]; then
printf "Table output is valid when used as body content.\n"
else
printf "Validator report:\n%s" "$json"
exit_code=1
fi
done
exit "$exit_code"

View file

@ -46,6 +46,7 @@ import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import qualified Text.XML.Light as Xml
-- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange
@ -349,8 +350,8 @@ blockToJATS _ b@(RawBlock f str)
report $ BlockNotRendered b
return empty
blockToJATS _ HorizontalRule = return empty -- not semantic
blockToJATS opts (Table attr blkCapt specs th tb tf) =
tableToJATS opts attr blkCapt specs th tb tf
blockToJATS opts (Table attr caption colspecs thead tbody tfoot) =
tableToJATS opts (Ann.toTable attr caption colspecs thead tbody tfoot)
-- | Convert a list of inline elements to JATS.
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)

View file

@ -1,4 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{- |
Module : Text.Pandoc.Writers.JATS.Table
Copyright : © 2020 Albert Krewinkel
@ -14,69 +16,233 @@ module Text.Pandoc.Writers.JATS.Table
( tableToJATS
) where
import Control.Monad.Reader (asks)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import Text.DocLayout (Doc, empty, vcat, ($$))
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions)
import Text.DocLayout (Doc, empty, vcat, ($$))
import Text.Pandoc.Shared (tshow)
import Text.Pandoc.Writers.JATS.Types
import Text.Pandoc.Writers.Shared (toLegacyTable)
import Text.Pandoc.XML (inTags, inTagsIndented, selfClosingTag)
import qualified Data.Text as T
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
tableToJATS :: PandocMonad m
=> WriterOptions
-> Attr -> Caption -> [ColSpec] -> TableHead
-> [TableBody] -> TableFoot
-> Ann.Table
-> JATS m (Doc Text)
tableToJATS opts _attr blkCapt specs th tb tf = do
blockToJATS <- asks jatsBlockWriter
let (caption, aligns, widths, headers, rows) =
toLegacyTable blkCapt specs th tb tf
captionDoc <- if null caption
then return mempty
else inTagsIndented "caption" <$> blockToJATS opts (Para caption)
tbl <- captionlessTable aligns widths headers rows
tableToJATS opts (Ann.Table attr caption colspecs thead tbodies tfoot) = do
let (Caption _maybeShortCaption captionBlocks) = caption
tbl <- captionlessTable opts attr colspecs thead tbodies tfoot
captionDoc <- if null captionBlocks
then return empty
else do
blockToJATS <- asks jatsBlockWriter
inTagsIndented "caption" . vcat <$>
mapM (blockToJATS opts) captionBlocks
return $ inTags True "table-wrap" [] $ captionDoc $$ tbl
where
captionlessTable aligns widths headers rows = do
let percent w = tshow (truncate (100*w) :: Integer) <> "*"
let coltags = vcat $ zipWith (\w al -> selfClosingTag "col"
([("width", percent w) | w > 0] ++
[("align", alignmentToText al)])) widths aligns
thead <- if all null headers
then return empty
else inTagsIndented "thead" <$> tableRowToJATS opts True headers
tbody <- inTagsIndented "tbody" . vcat <$>
mapM (tableRowToJATS opts False) rows
return $ inTags True "table" [] $ coltags $$ thead $$ tbody
alignmentToText :: Alignment -> Text
alignmentToText alignment = case alignment of
AlignLeft -> "left"
AlignRight -> "right"
AlignCenter -> "center"
AlignDefault -> "left"
captionlessTable :: PandocMonad m
=> WriterOptions
-> Attr
-> [ColSpec]
-> Ann.TableHead
-> [Ann.TableBody]
-> Ann.TableFoot
-> JATS m (Doc Text)
captionlessTable opts attr colspecs thead tbodies tfoot = do
head' <- tableHeadToJats opts thead
bodies <- mapM (tableBodyToJats opts) tbodies
foot' <- tableFootToJats opts tfoot
let validAttribs = [ "border", "cellpadding", "cellspacing", "content-type"
, "frame", "rules", "specific-use", "style", "summary"
, "width"
]
let attribs = toAttribs attr validAttribs
return $ inTags True "table" attribs $ vcat
[ colSpecListToJATS colspecs
, head'
, foot'
, vcat bodies
]
tableRowToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [[Block]]
-> JATS m (Doc Text)
tableRowToJATS opts isHeader cols =
inTagsIndented "tr" . vcat <$> mapM (tableItemToJATS opts isHeader) cols
validTablePartAttribs :: [Text]
validTablePartAttribs =
[ "align", "char", "charoff", "content-type", "style", "valign" ]
tableItemToJATS :: PandocMonad m
tableBodyToJats :: PandocMonad m
=> WriterOptions
-> Bool
-> [Block]
-> Ann.TableBody
-> JATS m (Doc Text)
tableItemToJATS opts isHeader [Plain item] = do
inlinesToJATS <- asks jatsInlinesWriter
inTags False (if isHeader then "th" else "td") [] <$>
inlinesToJATS opts item
tableItemToJATS opts isHeader item = do
blockToJATS <- asks jatsBlockWriter
inTags False (if isHeader then "th" else "td") [] . vcat <$>
mapM (blockToJATS opts) item
tableBodyToJats opts (Ann.TableBody attr _rowHeadCols inthead rows) = do
let attribs = toAttribs attr validTablePartAttribs
intermediateHead <- if null inthead
then return mempty
else headerRowsToJats opts Thead inthead
bodyRows <- bodyRowsToJats opts rows
return $ inTags True "tbody" attribs $ intermediateHead $$ bodyRows
tableHeadToJats :: PandocMonad m
=> WriterOptions
-> Ann.TableHead
-> JATS m (Doc Text)
tableHeadToJats opts (Ann.TableHead attr rows) =
tablePartToJats opts Thead attr rows
tableFootToJats :: PandocMonad m
=> WriterOptions
-> Ann.TableFoot
-> JATS m (Doc Text)
tableFootToJats opts (Ann.TableFoot attr rows) =
tablePartToJats opts Tfoot attr rows
tablePartToJats :: PandocMonad m
=> WriterOptions
-> TablePart
-> Attr
-> [Ann.HeaderRow]
-> JATS m (Doc Text)
tablePartToJats opts tblpart attr rows =
if null rows || all isEmptyRow rows
then return mempty
else do
let tag' = case tblpart of
Thead -> "thead"
Tfoot -> "tfoot"
Tbody -> "tbody" -- this would be unexpected
let attribs = toAttribs attr validTablePartAttribs
inTags True tag' attribs <$> headerRowsToJats opts tblpart rows
where
isEmptyRow (Ann.HeaderRow _attr _rownum cells) = all isEmptyCell cells
isEmptyCell (Ann.Cell _colspecs _colnum cell) =
cell == Cell nullAttr AlignDefault (RowSpan 1) (ColSpan 1) []
-- | The part of a table; header, footer, or body.
data TablePart = Thead | Tfoot | Tbody
deriving (Eq)
data CellType = HeaderCell | BodyCell
data TableRow = TableRow TablePart Attr Ann.RowNumber Ann.RowHead Ann.RowBody
headerRowsToJats :: PandocMonad m
=> WriterOptions
-> TablePart
-> [Ann.HeaderRow]
-> JATS m (Doc Text)
headerRowsToJats opts tablepart =
rowListToJats opts . map toTableRow
where
toTableRow (Ann.HeaderRow attr rownum rowbody) =
TableRow tablepart attr rownum [] rowbody
bodyRowsToJats :: PandocMonad m
=> WriterOptions
-> [Ann.BodyRow]
-> JATS m (Doc Text)
bodyRowsToJats opts =
rowListToJats opts . zipWith toTableRow [1..]
where
toTableRow rownum (Ann.BodyRow attr _rownum rowhead rowbody) =
TableRow Tbody attr rownum rowhead rowbody
rowListToJats :: PandocMonad m
=> WriterOptions
-> [TableRow]
-> JATS m (Doc Text)
rowListToJats opts = fmap vcat . mapM (tableRowToJats opts)
colSpecListToJATS :: [ColSpec] -> Doc Text
colSpecListToJATS colspecs =
let hasDefaultWidth (_, ColWidthDefault) = True
hasDefaultWidth _ = False
percent w = tshow (round (100*w) :: Integer) <> "%"
col :: ColWidth -> Doc Text
col = selfClosingTag "col" . \case
ColWidthDefault -> mempty
ColWidth w -> [("width", percent w)]
in if all hasDefaultWidth colspecs
then mempty
else inTags True "colgroup" [] $ vcat $ map (col . snd) colspecs
tableRowToJats :: PandocMonad m
=> WriterOptions
-> TableRow
-> JATS m (Doc Text)
tableRowToJats opts (TableRow tblpart attr _rownum rowhead rowbody) = do
let validAttribs = [ "align", "char", "charoff", "content-type"
, "style", "valign"
]
let attr' = toAttribs attr validAttribs
let celltype = case tblpart of
Thead -> HeaderCell
_ -> BodyCell
headcells <- mapM (cellToJats opts HeaderCell) rowhead
bodycells <- mapM (cellToJats opts celltype) rowbody
return $ inTags True "tr" attr' $ mconcat
[ vcat headcells
, vcat bodycells
]
alignmentAttrib :: Alignment -> Maybe (Text, Text)
alignmentAttrib = fmap ("align",) . \case
AlignLeft -> Just "left"
AlignRight -> Just "right"
AlignCenter -> Just "center"
AlignDefault -> Nothing
colspanAttrib :: ColSpan -> Maybe (Text, Text)
colspanAttrib = \case
ColSpan 1 -> Nothing
ColSpan n -> Just ("colspan", tshow n)
rowspanAttrib :: RowSpan -> Maybe (Text, Text)
rowspanAttrib = \case
RowSpan 1 -> Nothing
RowSpan n -> Just ("rowspan", tshow n)
cellToJats :: PandocMonad m
=> WriterOptions
-> CellType
-> Ann.Cell
-> JATS m (Doc Text)
cellToJats opts celltype (Ann.Cell (colspec :| _) _colNum cell) =
let align = fst colspec
in tableCellToJats opts celltype align cell
toAttribs :: Attr -> [Text] -> [(Text, Text)]
toAttribs (ident, _classes, kvs) knownAttribs =
(if T.null ident then id else (("id", ident) :)) $
filter ((`elem` knownAttribs) . fst) kvs
tableCellToJats :: PandocMonad m
=> WriterOptions
-> CellType
-> Alignment
-> Cell
-> JATS m (Doc Text)
tableCellToJats opts ctype colAlign (Cell attr align rowspan colspan item) = do
blockToJats <- asks jatsBlockWriter
inlinesToJats <- asks jatsInlinesWriter
let cellContents = \case
[Plain inlines] -> inlinesToJats opts inlines
blocks -> vcat <$> mapM (blockToJats opts) blocks
let tag' = case ctype of
BodyCell -> "td"
HeaderCell -> "th"
let align' = case align of
AlignDefault -> colAlign
_ -> align
let maybeCons = maybe id (:)
let validAttribs = [ "abbr", "align", "axis", "char", "charoff"
, "content-type", "headers", "scope", "style", "valign"
]
let attribs = maybeCons (alignmentAttrib align')
. maybeCons (rowspanAttrib rowspan)
. maybeCons (colspanAttrib colspan)
$ toAttribs attr validAttribs
inTags False tag' attribs <$> cellContents item

View file

@ -101,7 +101,7 @@ tests pandocPath =
, testGroup "jats"
[ testGroup "writer"
[ testGroup "jats_archiving" $
writerTests' "jats_archiving"
extWriterTests' "jats_archiving"
, testGroup "jats_articleauthoring" $
writerTests' "jats_articleauthoring"
, testGroup "jats_publishing" $

View file

@ -4,35 +4,31 @@
<p>Demonstration of simple table syntax.</p>
</caption>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -41,35 +37,31 @@
<p>Simple table without caption:</p>
<table-wrap>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -81,35 +73,31 @@
<p>Demonstration of simple table syntax.</p>
</caption>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -121,30 +109,33 @@
<p>Heres the caption. It may span multiple lines.</p>
</caption>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<thead>
<tr>
<th>Centered Header</th>
<th>Left Aligned</th>
<th>Right Aligned</th>
<th>Default aligned</th>
<th align="center">Centered Header</th>
<th align="left">Left Aligned</th>
<th align="right">Right Aligned</th>
<th align="left">Default aligned</th>
</tr>
</thead>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td>Example of a row that spans multiple lines.</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td align="left">Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td align="left">Heres another one. Note the blank line between
rows.</td>
</tr>
</tbody>
</table>
@ -152,30 +143,33 @@
<p>Multiline table without caption:</p>
<table-wrap>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<thead>
<tr>
<th>Centered Header</th>
<th>Left Aligned</th>
<th>Right Aligned</th>
<th>Default aligned</th>
<th align="center">Centered Header</th>
<th align="left">Left Aligned</th>
<th align="right">Right Aligned</th>
<th align="left">Default aligned</th>
</tr>
</thead>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td>Example of a row that spans multiple lines.</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td align="left">Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td align="left">Heres another one. Note the blank line between
rows.</td>
</tr>
</tbody>
</table>
@ -183,28 +177,24 @@
<p>Table without column headers:</p>
<table-wrap>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="right" />
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td align="right">12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td align="right">123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td align="right">1</td>
</tr>
</tbody>
</table>
@ -212,21 +202,23 @@
<p>Multiline table without column headers:</p>
<table-wrap>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td>Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
</tr>
</tbody>

View file

@ -4,35 +4,31 @@
<p>Demonstration of simple table syntax.</p>
</caption>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -41,35 +37,31 @@
<p>Simple table without caption:</p>
<table-wrap>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -81,35 +73,31 @@
<p>Demonstration of simple table syntax.</p>
</caption>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -121,30 +109,33 @@
<p>Heres the caption. It may span multiple lines.</p>
</caption>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<thead>
<tr>
<th>Centered Header</th>
<th>Left Aligned</th>
<th>Right Aligned</th>
<th>Default aligned</th>
<th align="center">Centered Header</th>
<th align="left">Left Aligned</th>
<th align="right">Right Aligned</th>
<th align="left">Default aligned</th>
</tr>
</thead>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td>Example of a row that spans multiple lines.</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td align="left">Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td align="left">Heres another one. Note the blank line between
rows.</td>
</tr>
</tbody>
</table>
@ -152,30 +143,33 @@
<p>Multiline table without caption:</p>
<table-wrap>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<thead>
<tr>
<th>Centered Header</th>
<th>Left Aligned</th>
<th>Right Aligned</th>
<th>Default aligned</th>
<th align="center">Centered Header</th>
<th align="left">Left Aligned</th>
<th align="right">Right Aligned</th>
<th align="left">Default aligned</th>
</tr>
</thead>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td>Example of a row that spans multiple lines.</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td align="left">Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td align="left">Heres another one. Note the blank line between
rows.</td>
</tr>
</tbody>
</table>
@ -183,28 +177,24 @@
<p>Table without column headers:</p>
<table-wrap>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="right" />
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td align="right">12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td align="right">123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td align="right">1</td>
</tr>
</tbody>
</table>
@ -212,21 +202,23 @@
<p>Multiline table without column headers:</p>
<table-wrap>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td>Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
</tr>
</tbody>

View file

@ -4,35 +4,31 @@
<p>Demonstration of simple table syntax.</p>
</caption>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -41,35 +37,31 @@
<p>Simple table without caption:</p>
<table-wrap>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -81,35 +73,31 @@
<p>Demonstration of simple table syntax.</p>
</caption>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="left" />
<thead>
<tr>
<th>Right</th>
<th>Left</th>
<th>Center</th>
<th align="right">Right</th>
<th align="left">Left</th>
<th align="center">Center</th>
<th>Default</th>
</tr>
</thead>
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td>12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td>123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td>1</td>
</tr>
</tbody>
@ -121,30 +109,33 @@
<p>Heres the caption. It may span multiple lines.</p>
</caption>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<thead>
<tr>
<th>Centered Header</th>
<th>Left Aligned</th>
<th>Right Aligned</th>
<th>Default aligned</th>
<th align="center">Centered Header</th>
<th align="left">Left Aligned</th>
<th align="right">Right Aligned</th>
<th align="left">Default aligned</th>
</tr>
</thead>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td>Example of a row that spans multiple lines.</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td align="left">Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td align="left">Heres another one. Note the blank line between
rows.</td>
</tr>
</tbody>
</table>
@ -152,30 +143,33 @@
<p>Multiline table without caption:</p>
<table-wrap>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<thead>
<tr>
<th>Centered Header</th>
<th>Left Aligned</th>
<th>Right Aligned</th>
<th>Default aligned</th>
<th align="center">Centered Header</th>
<th align="left">Left Aligned</th>
<th align="right">Right Aligned</th>
<th align="left">Default aligned</th>
</tr>
</thead>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td>Example of a row that spans multiple lines.</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td align="left">Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td align="left">Heres another one. Note the blank line between
rows.</td>
</tr>
</tbody>
</table>
@ -183,28 +177,24 @@
<p>Table without column headers:</p>
<table-wrap>
<table>
<col align="right" />
<col align="left" />
<col align="center" />
<col align="right" />
<tbody>
<tr>
<td>12</td>
<td>12</td>
<td>12</td>
<td>12</td>
<td align="right">12</td>
<td align="left">12</td>
<td align="center">12</td>
<td align="right">12</td>
</tr>
<tr>
<td>123</td>
<td>123</td>
<td>123</td>
<td>123</td>
<td align="right">123</td>
<td align="left">123</td>
<td align="center">123</td>
<td align="right">123</td>
</tr>
<tr>
<td>1</td>
<td>1</td>
<td>1</td>
<td>1</td>
<td align="right">1</td>
<td align="left">1</td>
<td align="center">1</td>
<td align="right">1</td>
</tr>
</tbody>
</table>
@ -212,21 +202,23 @@
<p>Multiline table without column headers:</p>
<table-wrap>
<table>
<col width="15*" align="center" />
<col width="13*" align="left" />
<col width="16*" align="right" />
<col width="35*" align="left" />
<colgroup>
<col width="15%" />
<col width="14%" />
<col width="16%" />
<col width="35%" />
</colgroup>
<tbody>
<tr>
<td>First</td>
<td>row</td>
<td>12.0</td>
<td align="center">First</td>
<td align="left">row</td>
<td align="right">12.0</td>
<td>Example of a row that spans multiple lines.</td>
</tr>
<tr>
<td>Second</td>
<td>row</td>
<td>5.0</td>
<td align="center">Second</td>
<td align="left">row</td>
<td align="right">5.0</td>
<td>Heres another one. Note the blank line between rows.</td>
</tr>
</tbody>

View file

@ -0,0 +1,58 @@
<table-wrap>
<caption>
<p>States belonging to the <italic>Nordics.</italic></p>
</caption>
<table id="nordics">
<colgroup>
<col width="30%" />
<col width="30%" />
<col width="20%" />
<col width="20%" />
</colgroup>
<thead>
<tr>
<th align="center">Name</th>
<th align="center">Capital</th>
<th align="center">Population
(in 2018)</th>
<th align="center">Area
(in km<sup>2</sup>)</th>
</tr>
</thead>
<tfoot>
<tr id="summary">
<td align="center">Total</td>
<td align="left"></td>
<td align="left" id="total-population">27,376,022</td>
<td align="left" id="total-area">1,258,336</td>
</tr>
</tfoot>
<tbody>
<tr>
<th align="center">Denmark</th><td align="left">Copenhagen</td>
<td align="left">5,809,502</td>
<td align="left">43,094</td>
</tr>
<tr>
<th align="center">Finland</th><td align="left">Helsinki</td>
<td align="left">5,537,364</td>
<td align="left">338,145</td>
</tr>
<tr>
<th align="center">Iceland</th><td align="left">Reykjavik</td>
<td align="left">343,518</td>
<td align="left">103,000</td>
</tr>
<tr>
<th align="center">Norway</th><td align="left">Oslo</td>
<td align="left">5,372,191</td>
<td align="left">323,802</td>
</tr>
<tr>
<th align="center">Sweden</th><td align="left">Stockholm</td>
<td align="left">10,313,447</td>
<td align="left">450,295</td>
</tr>
</tbody>
</table>
</table-wrap>

View file

@ -0,0 +1,128 @@
<table-wrap>
<caption>
<p>Data about the planets of our solar system.</p>
</caption>
<table>
<thead>
<tr>
<th align="center" colspan="2"></th>
<th>Name</th>
<th align="right">Mass (10^24kg)</th>
<th align="right">Diameter (km)</th>
<th align="right">Density (kg/m^3)</th>
<th align="right">Gravity (m/s^2)</th>
<th align="right">Length of day (hours)</th>
<th align="right">Distance from Sun (10^6km)</th>
<th align="right">Mean temperature (C)</th>
<th align="right">Number of moons</th>
<th>Notes</th>
</tr>
</thead>
<tbody>
<tr>
<th align="center" rowspan="4" colspan="2">Terrestrial planets</th>
<th>Mercury</th><td align="right">0.330</td>
<td align="right">4,879</td>
<td align="right">5427</td>
<td align="right">3.7</td>
<td align="right">4222.6</td>
<td align="right">57.9</td>
<td align="right">167</td>
<td align="right">0</td>
<td>Closest to the Sun</td>
</tr>
<tr>
<th>Venus</th><td align="right">4.87</td>
<td align="right">12,104</td>
<td align="right">5243</td>
<td align="right">8.9</td>
<td align="right">2802.0</td>
<td align="right">108.2</td>
<td align="right">464</td>
<td align="right">0</td>
<td></td>
</tr>
<tr>
<th>Earth</th><td align="right">5.97</td>
<td align="right">12,756</td>
<td align="right">5514</td>
<td align="right">9.8</td>
<td align="right">24.0</td>
<td align="right">149.6</td>
<td align="right">15</td>
<td align="right">1</td>
<td>Our world</td>
</tr>
<tr>
<th>Mars</th><td align="right">0.642</td>
<td align="right">6,792</td>
<td align="right">3933</td>
<td align="right">3.7</td>
<td align="right">24.7</td>
<td align="right">227.9</td>
<td align="right">-65</td>
<td align="right">2</td>
<td>The red planet</td>
</tr>
<tr>
<th align="center" rowspan="4">Jovian planets</th>
<th align="center" rowspan="2">Gas giants</th>
<th>Jupiter</th><td align="right">1898</td>
<td align="right">142,984</td>
<td align="right">1326</td>
<td align="right">23.1</td>
<td align="right">9.9</td>
<td align="right">778.6</td>
<td align="right">-110</td>
<td align="right">67</td>
<td>The largest planet</td>
</tr>
<tr>
<th>Saturn</th><td align="right">568</td>
<td align="right">120,536</td>
<td align="right">687</td>
<td align="right">9.0</td>
<td align="right">10.7</td>
<td align="right">1433.5</td>
<td align="right">-140</td>
<td align="right">62</td>
<td></td>
</tr>
<tr>
<th align="center" rowspan="2">Ice giants</th>
<th>Uranus</th><td align="right">86.8</td>
<td align="right">51,118</td>
<td align="right">1271</td>
<td align="right">8.7</td>
<td align="right">17.2</td>
<td align="right">2872.5</td>
<td align="right">-195</td>
<td align="right">27</td>
<td></td>
</tr>
<tr>
<th>Neptune</th><td align="right">102</td>
<td align="right">49,528</td>
<td align="right">1638</td>
<td align="right">11.0</td>
<td align="right">16.1</td>
<td align="right">4495.1</td>
<td align="right">-200</td>
<td align="right">14</td>
<td></td>
</tr>
<tr>
<th align="center" colspan="2">Dwarf planets</th>
<th>Pluto</th><td align="right">0.0146</td>
<td align="right">2,370</td>
<td align="right">2095</td>
<td align="right">0.7</td>
<td align="right">153.3</td>
<td align="right">5906.4</td>
<td align="right">-225</td>
<td align="right">5</td>
<td>Declassified as a planet in 2006.</td>
</tr>
</tbody>
</table>
</table-wrap>

View file

@ -0,0 +1,56 @@
<table-wrap>
<caption>
<p>List of Students</p>
</caption>
<table id="students">
<colgroup>
<col width="50%" />
<col width="50%" />
</colgroup>
<thead>
<tr>
<th align="center">Student ID</th>
<th align="center">Name</th>
</tr>
</thead>
<tbody>
<tr>
<th align="left" colspan="2">Computer Science</th>
</tr>
<tr>
<td align="left">3741255</td>
<td align="left">Jones, Martha</td>
</tr>
<tr>
<td align="left">4077830</td>
<td align="left">Pierce, Benjamin</td>
</tr>
<tr>
<td align="left">5151701</td>
<td align="left">Kirk, James</td>
</tr>
</tbody>
<tbody>
<tr>
<th align="left" colspan="2">Russian Literature</th>
</tr>
<tr>
<td align="left">3971244</td>
<td align="left">Nim, Victor</td>
</tr>
</tbody>
<tbody>
<tr>
<th align="left" colspan="2">Astrophysics</th>
</tr>
<tr>
<td align="left">4100332</td>
<td align="left">Petrov, Alexandra</td>
</tr>
<tr>
<td align="left">4100332</td>
<td align="left">Toyota, Hiroko</td>
</tr>
</tbody>
</table>
</table-wrap>