Implemented tight lists in context, latex writers.

This commit is contained in:
John MacFarlane 2013-01-07 20:12:13 -08:00
parent 7909982f9a
commit 1a9193c30d
2 changed files with 27 additions and 13 deletions

View file

@ -46,8 +46,8 @@ data WriterState =
, stOptions :: WriterOptions -- writer options
}
orderedListStyles :: [[Char]]
orderedListStyles = cycle ["[n]","[a]", "[r]", "[g]"]
orderedListStyles :: [Char]
orderedListStyles = cycle "narg"
-- | Convert Pandoc to ConTeXt.
writeConTeXt :: WriterOptions -> Pandoc -> String
@ -148,7 +148,10 @@ blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline
blockToConTeXt (RawBlock _ _ ) = return empty
blockToConTeXt (BulletList lst) = do
contents <- mapM listItemToConTeXt lst
return $ "\\startitemize" $$ vcat contents $$ text "\\stopitemize" <> blankline
return $ ("\\startitemize" <> if isTightList lst
then brackets "packed"
else empty) $$
vcat contents $$ text "\\stopitemize" <> blankline
blockToConTeXt (OrderedList (start, style', delim) lst) = do
st <- get
let level = stOrderedListLevel st
@ -171,14 +174,15 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do
let specs2 = if null specs2Items
then ""
else "[" ++ intercalate "," specs2Items ++ "]"
let style'' = case style' of
DefaultStyle -> orderedListStyles !! level
Decimal -> "[n]"
Example -> "[n]"
LowerRoman -> "[r]"
UpperRoman -> "[R]"
LowerAlpha -> "[a]"
UpperAlpha -> "[A]"
let style'' = '[': (case style' of
DefaultStyle -> orderedListStyles !! level
Decimal -> 'n'
Example -> 'n'
LowerRoman -> 'r'
UpperRoman -> 'R'
LowerAlpha -> 'a'
UpperAlpha -> 'A') :
if isTightList lst then ",packed]" else "]"
let specs = style'' ++ specs2
return $ "\\startitemize" <> text specs $$ vcat contents $$
"\\stopitemize" <> blankline

View file

@ -351,7 +351,10 @@ blockToLaTeX (BulletList lst) = do
incremental <- gets stIncremental
let inc = if incremental then "[<+->]" else ""
items <- mapM listItemToLaTeX lst
return $ text ("\\begin{itemize}" ++ inc) $$ vcat items $$
let spacing = if isTightList lst
then text "\\itemsep1pt\\parskip0pt\\parsep0pt"
else empty
return $ text ("\\begin{itemize}" ++ inc) $$ spacing $$ vcat items $$
"\\end{itemize}"
blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
st <- get
@ -381,16 +384,23 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
then empty
else "\\setcounter" <> braces enum <>
braces (text $ show $ start - 1)
let spacing = if isTightList lst
then text "\\itemsep1pt\\parskip0pt\\parsep0pt"
else empty
return $ text ("\\begin{enumerate}" ++ inc)
$$ stylecommand
$$ resetcounter
$$ spacing
$$ vcat items
$$ "\\end{enumerate}"
blockToLaTeX (DefinitionList lst) = do
incremental <- gets stIncremental
let inc = if incremental then "[<+->]" else ""
items <- mapM defListItemToLaTeX lst
return $ text ("\\begin{description}" ++ inc) $$ vcat items $$
let spacing = if and $ map isTightList (map snd lst)
then text "\\itemsep1pt\\parskip0pt\\parsep0pt"
else empty
return $ text ("\\begin{description}" ++ inc) $$ spacing $$ vcat items $$
"\\end{description}"
blockToLaTeX HorizontalRule = return $
"\\begin{center}\\rule{3in}{0.4pt}\\end{center}"