81403b8d80
Otherwise we can get problems with linebreaks, and cell spacing isn't right. Thanks to Jef Allbright for pointing out the problem.
479 lines
20 KiB
Haskell
479 lines
20 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-
|
|
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
-}
|
|
|
|
{- |
|
|
Module : Text.Pandoc.Writers.LaTeX
|
|
Copyright : Copyright (C) 2006-2010 John MacFarlane
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley.edu>
|
|
Stability : alpha
|
|
Portability : portable
|
|
|
|
Conversion of 'Pandoc' format into LaTeX.
|
|
-}
|
|
module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
|
|
import Text.Pandoc.Definition
|
|
import Text.Pandoc.Generic
|
|
import Text.Pandoc.Shared
|
|
import Text.Pandoc.Templates
|
|
import Text.Printf ( printf )
|
|
import Data.List ( (\\), isSuffixOf, isPrefixOf, intercalate, intersperse )
|
|
import Data.Char ( toLower, isPunctuation )
|
|
import Control.Monad.State
|
|
import Text.Pandoc.Pretty
|
|
import System.FilePath (dropExtension)
|
|
|
|
data WriterState =
|
|
WriterState { stInNote :: Bool -- @True@ if we're in a note
|
|
, stOLLevel :: Int -- level of ordered list nesting
|
|
, stOptions :: WriterOptions -- writer options, so they don't have to be parameter
|
|
, stVerbInNote :: Bool -- true if document has verbatim text in note
|
|
, stEnumerate :: Bool -- true if document needs fancy enumerated lists
|
|
, stTable :: Bool -- true if document has a table
|
|
, stStrikeout :: Bool -- true if document has strikeout
|
|
, stSubscript :: Bool -- true if document has subscript
|
|
, stUrl :: Bool -- true if document has visible URL link
|
|
, stGraphics :: Bool -- true if document contains images
|
|
, stLHS :: Bool -- true if document has literate haskell code
|
|
, stBook :: Bool -- true if document uses book or memoir class
|
|
}
|
|
|
|
-- | Convert Pandoc to LaTeX.
|
|
writeLaTeX :: WriterOptions -> Pandoc -> String
|
|
writeLaTeX options document =
|
|
evalState (pandocToLaTeX options document) $
|
|
WriterState { stInNote = False, stOLLevel = 1, stOptions = options,
|
|
stVerbInNote = False, stEnumerate = False,
|
|
stTable = False, stStrikeout = False, stSubscript = False,
|
|
stUrl = False, stGraphics = False,
|
|
stLHS = False, stBook = False }
|
|
|
|
pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String
|
|
pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
|
|
let template = writerTemplate options
|
|
let usesBookClass x = "\\documentclass" `isPrefixOf` x &&
|
|
("{memoir}" `isSuffixOf` x || "{book}" `isSuffixOf` x ||
|
|
"{report}" `isSuffixOf` x)
|
|
when (any usesBookClass (lines template)) $
|
|
modify $ \s -> s{stBook = True}
|
|
opts <- liftM stOptions get
|
|
let colwidth = if writerWrapText opts
|
|
then Just $ writerColumns opts
|
|
else Nothing
|
|
titletext <- liftM (render colwidth) $ inlineListToLaTeX title
|
|
authorsText <- mapM (liftM (render colwidth) . inlineListToLaTeX) authors
|
|
dateText <- liftM (render colwidth) $ inlineListToLaTeX date
|
|
let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then
|
|
(blocks, [])
|
|
else case last blocks of
|
|
Header 1 il -> (init blocks, il)
|
|
_ -> (blocks, [])
|
|
body <- blockListToLaTeX blocks'
|
|
biblioTitle <- liftM (render colwidth) $ inlineListToLaTeX lastHeader
|
|
let main = render colwidth body
|
|
st <- get
|
|
let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options
|
|
citecontext = case writerCiteMethod options of
|
|
Natbib -> [ ("biblio-files", biblioFiles)
|
|
, ("biblio-title", biblioTitle)
|
|
, ("natbib", "yes")
|
|
]
|
|
Biblatex -> [ ("biblio-files", biblioFiles)
|
|
, ("biblio-title", biblioTitle)
|
|
, ("biblatex", "yes")
|
|
]
|
|
_ -> []
|
|
context = writerVariables options ++
|
|
[ ("toc", if writerTableOfContents options then "yes" else "")
|
|
, ("body", main)
|
|
, ("title", titletext)
|
|
, ("date", dateText) ] ++
|
|
[ ("author", a) | a <- authorsText ] ++
|
|
[ ("xetex", "yes") | writerXeTeX options ] ++
|
|
[ ("verbatim-in-note", "yes") | stVerbInNote st ] ++
|
|
[ ("fancy-enums", "yes") | stEnumerate st ] ++
|
|
[ ("tables", "yes") | stTable st ] ++
|
|
[ ("strikeout", "yes") | stStrikeout st ] ++
|
|
[ ("subscript", "yes") | stSubscript st ] ++
|
|
[ ("url", "yes") | stUrl st ] ++
|
|
[ ("numbersections", "yes") | writerNumberSections options ] ++
|
|
[ ("lhs", "yes") | stLHS st ] ++
|
|
[ ("graphics", "yes") | stGraphics st ] ++
|
|
[ ("book-class", "yes") | stBook st] ++
|
|
citecontext
|
|
return $ if writerStandalone options
|
|
then renderTemplate context template
|
|
else main
|
|
|
|
-- escape things as needed for LaTeX
|
|
|
|
stringToLaTeX :: String -> String
|
|
stringToLaTeX = escapeStringUsing latexEscapes
|
|
where latexEscapes = backslashEscapes "{}$%&_#" ++
|
|
[ ('^', "\\^{}")
|
|
, ('\\', "\\textbackslash{}")
|
|
, ('~', "\\ensuremath{\\sim}")
|
|
, ('|', "\\textbar{}")
|
|
, ('<', "\\textless{}")
|
|
, ('>', "\\textgreater{}")
|
|
, ('[', "{[}") -- to avoid interpretation as
|
|
, (']', "{]}") -- optional arguments
|
|
, ('\160', "~")
|
|
, ('\x2018', "`")
|
|
, ('\x2019', "'")
|
|
, ('\x201C', "``")
|
|
, ('\x201D', "''")
|
|
]
|
|
|
|
-- | Puts contents into LaTeX command.
|
|
inCmd :: String -> Doc -> Doc
|
|
inCmd cmd contents = char '\\' <> text cmd <> braces contents
|
|
|
|
-- | Remove all code elements from list of inline elements
|
|
-- (because it's illegal to have verbatim inside some command arguments)
|
|
deVerb :: [Inline] -> [Inline]
|
|
deVerb [] = []
|
|
deVerb ((Code str):rest) =
|
|
(TeX $ "\\texttt{" ++ stringToLaTeX str ++ "}"):(deVerb rest)
|
|
deVerb (other:rest) = other:(deVerb rest)
|
|
|
|
-- | Convert Pandoc block element to LaTeX.
|
|
blockToLaTeX :: Block -- ^ Block to convert
|
|
-> State WriterState Doc
|
|
blockToLaTeX Null = return empty
|
|
blockToLaTeX (Plain lst) = inlineListToLaTeX lst
|
|
blockToLaTeX (Para [Image txt (src,tit)]) = do
|
|
capt <- inlineListToLaTeX txt
|
|
img <- inlineToLaTeX (Image txt (src,tit))
|
|
return $ "\\begin{figure}[htb]" $$ "\\centering" $$ img $$
|
|
("\\caption{" <> capt <> char '}') $$ "\\end{figure}" $$ blankline
|
|
blockToLaTeX (Para lst) = do
|
|
result <- inlineListToLaTeX lst
|
|
return $ result <> blankline
|
|
blockToLaTeX (BlockQuote lst) = do
|
|
contents <- blockListToLaTeX lst
|
|
return $ "\\begin{quote}" $$ contents $$ "\\end{quote}"
|
|
blockToLaTeX (CodeBlock (_,classes,_) str) = do
|
|
st <- get
|
|
env <- if writerLiterateHaskell (stOptions st) && "haskell" `elem` classes &&
|
|
"literate" `elem` classes
|
|
then do
|
|
modify $ \s -> s{ stLHS = True }
|
|
return "code"
|
|
else if stInNote st
|
|
then do
|
|
modify $ \s -> s{ stVerbInNote = True }
|
|
return "Verbatim"
|
|
else return "verbatim"
|
|
return $ "\\begin{" <> text env <> "}" $$ flush (text str) $$
|
|
"\\end{" <> text env <> "}" $$ cr -- final cr needed because of footnotes
|
|
blockToLaTeX (RawHtml _) = return empty
|
|
blockToLaTeX (BulletList lst) = do
|
|
items <- mapM listItemToLaTeX lst
|
|
return $ "\\begin{itemize}" $$ vcat items $$ "\\end{itemize}"
|
|
blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
|
|
st <- get
|
|
let oldlevel = stOLLevel st
|
|
put $ st {stOLLevel = oldlevel + 1}
|
|
items <- mapM listItemToLaTeX lst
|
|
modify (\s -> s {stOLLevel = oldlevel})
|
|
exemplar <- if numstyle /= DefaultStyle || numdelim /= DefaultDelim
|
|
then do
|
|
modify $ \s -> s{ stEnumerate = True }
|
|
return $ char '[' <>
|
|
text (head (orderedListMarkers (1, numstyle,
|
|
numdelim))) <> char ']'
|
|
else return empty
|
|
let resetcounter = if start /= 1 && oldlevel <= 4
|
|
then text $ "\\setcounter{enum" ++
|
|
map toLower (toRomanNumeral oldlevel) ++
|
|
"}{" ++ show (start - 1) ++ "}"
|
|
else empty
|
|
return $ "\\begin{enumerate}" <> exemplar $$ resetcounter $$
|
|
vcat items $$ "\\end{enumerate}"
|
|
blockToLaTeX (DefinitionList lst) = do
|
|
items <- mapM defListItemToLaTeX lst
|
|
return $ "\\begin{description}" $$ vcat items $$ "\\end{description}"
|
|
blockToLaTeX HorizontalRule = return $
|
|
"\\begin{center}\\rule{3in}{0.4pt}\\end{center}" $$ blankline
|
|
blockToLaTeX (Header level lst) = do
|
|
let lst' = deVerb lst
|
|
txt <- inlineListToLaTeX lst'
|
|
let noNote (Note _) = Str ""
|
|
noNote x = x
|
|
let lstNoNotes = bottomUp noNote lst'
|
|
-- footnotes in sections don't work unless you specify an optional
|
|
-- argument: \section[mysec]{mysec\footnote{blah}}
|
|
optional <- if lstNoNotes == lst'
|
|
then return empty
|
|
else do
|
|
res <- inlineListToLaTeX lstNoNotes
|
|
return $ char '[' <> res <> char ']'
|
|
let stuffing = optional <> char '{' <> txt <> char '}'
|
|
book <- liftM stBook get
|
|
let level' = if book then level - 1 else level
|
|
let headerWith x y = text x <> y $$ blankline
|
|
return $ case level' of
|
|
0 -> headerWith "\\chapter" stuffing
|
|
1 -> headerWith "\\section" stuffing
|
|
2 -> headerWith "\\subsection" stuffing
|
|
3 -> headerWith "\\subsubsection" stuffing
|
|
4 -> headerWith "\\paragraph" stuffing
|
|
5 -> headerWith "\\subparagraph" stuffing
|
|
_ -> txt $$ blankline
|
|
blockToLaTeX (Table caption aligns widths heads rows) = do
|
|
headers <- if all null heads
|
|
then return empty
|
|
else liftM ($$ "\\hline") $ (tableRowToLaTeX widths) heads
|
|
captionText <- inlineListToLaTeX caption
|
|
rows' <- mapM (tableRowToLaTeX widths) rows
|
|
let colDescriptors = concat $ zipWith toColDescriptor widths aligns
|
|
let tableBody = text ("\\begin{tabular}{" ++ colDescriptors ++ "}") $$
|
|
headers $$ vcat rows' $$ "\\end{tabular}"
|
|
let centered txt = "\\begin{center}" $$ txt $$ "\\end{center}"
|
|
modify $ \s -> s{ stTable = True }
|
|
return $ if isEmpty captionText
|
|
then centered tableBody $$ blankline
|
|
else "\\begin{table}[h]" $$ centered tableBody $$
|
|
inCmd "caption" captionText $$ "\\end{table}" $$ blankline
|
|
|
|
toColDescriptor :: Double -> Alignment -> String
|
|
toColDescriptor 0 align =
|
|
case align of
|
|
AlignLeft -> "l"
|
|
AlignRight -> "r"
|
|
AlignCenter -> "c"
|
|
AlignDefault -> "l"
|
|
toColDescriptor width align = ">{\\PBS" ++
|
|
(case align of
|
|
AlignLeft -> "\\raggedright"
|
|
AlignRight -> "\\raggedleft"
|
|
AlignCenter -> "\\centering"
|
|
AlignDefault -> "\\raggedright") ++
|
|
"\\hspace{0pt}}p{" ++ printf "%.2f" width ++ "\\columnwidth}"
|
|
|
|
blockListToLaTeX :: [Block] -> State WriterState Doc
|
|
blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . vcat
|
|
|
|
tableRowToLaTeX :: [Double] -> [[Block]] -> State WriterState Doc
|
|
tableRowToLaTeX widths cols = do
|
|
renderedCells <- mapM blockListToLaTeX cols
|
|
let toCell 0 c = c
|
|
toCell w c = "\\parbox{" <> text (printf "%.2f" w) <>
|
|
"\\columnwidth}{" <> c <> cr <> "}"
|
|
let cells = zipWith toCell widths renderedCells
|
|
return $ (hcat $ intersperse (" & ") cells) <> "\\\\"
|
|
|
|
listItemToLaTeX :: [Block] -> State WriterState Doc
|
|
listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item" $$) .
|
|
(nest 2)
|
|
|
|
defListItemToLaTeX :: ([Inline], [[Block]]) -> State WriterState Doc
|
|
defListItemToLaTeX (term, defs) = do
|
|
term' <- inlineListToLaTeX $ deVerb term
|
|
def' <- liftM vsep $ mapM blockListToLaTeX defs
|
|
return $ "\\item" <> brackets term' $$ def'
|
|
|
|
-- | Convert list of inline elements to LaTeX.
|
|
inlineListToLaTeX :: [Inline] -- ^ Inlines to convert
|
|
-> State WriterState Doc
|
|
inlineListToLaTeX lst = mapM inlineToLaTeX lst >>= return . hcat
|
|
|
|
isQuoted :: Inline -> Bool
|
|
isQuoted (Quoted _ _) = True
|
|
isQuoted Apostrophe = True
|
|
isQuoted _ = False
|
|
|
|
-- | Convert inline element to LaTeX
|
|
inlineToLaTeX :: Inline -- ^ Inline to convert
|
|
-> State WriterState Doc
|
|
inlineToLaTeX (Emph lst) =
|
|
inlineListToLaTeX (deVerb lst) >>= return . inCmd "emph"
|
|
inlineToLaTeX (Strong lst) =
|
|
inlineListToLaTeX (deVerb lst) >>= return . inCmd "textbf"
|
|
inlineToLaTeX (Strikeout lst) = do
|
|
contents <- inlineListToLaTeX $ deVerb lst
|
|
modify $ \s -> s{ stStrikeout = True }
|
|
return $ inCmd "sout" contents
|
|
inlineToLaTeX (Superscript lst) =
|
|
inlineListToLaTeX (deVerb lst) >>= return . inCmd "textsuperscript"
|
|
inlineToLaTeX (Subscript lst) = do
|
|
modify $ \s -> s{ stSubscript = True }
|
|
contents <- inlineListToLaTeX $ deVerb lst
|
|
-- oddly, latex includes \textsuperscript but not \textsubscript
|
|
-- so we have to define it (using a different name so as not to conflict with memoir class):
|
|
return $ inCmd "textsubscr" contents
|
|
inlineToLaTeX (SmallCaps lst) =
|
|
inlineListToLaTeX (deVerb lst) >>= return . inCmd "textsc"
|
|
inlineToLaTeX (Cite cits lst) = do
|
|
st <- get
|
|
let opts = stOptions st
|
|
case writerCiteMethod opts of
|
|
Natbib -> citationsToNatbib cits
|
|
Biblatex -> citationsToBiblatex cits
|
|
_ -> inlineListToLaTeX lst
|
|
|
|
inlineToLaTeX (Code str) = do
|
|
st <- get
|
|
when (stInNote st) $ modify $ \s -> s{ stVerbInNote = True }
|
|
let chr = ((enumFromTo '!' '~') \\ str) !! 0
|
|
return $ text $ "\\verb" ++ [chr] ++ str ++ [chr]
|
|
inlineToLaTeX (Quoted SingleQuote lst) = do
|
|
contents <- inlineListToLaTeX lst
|
|
let s1 = if (not (null lst)) && (isQuoted (head lst))
|
|
then "\\,"
|
|
else empty
|
|
let s2 = if (not (null lst)) && (isQuoted (last lst))
|
|
then "\\,"
|
|
else empty
|
|
return $ char '`' <> s1 <> contents <> s2 <> char '\''
|
|
inlineToLaTeX (Quoted DoubleQuote lst) = do
|
|
contents <- inlineListToLaTeX lst
|
|
let s1 = if (not (null lst)) && (isQuoted (head lst))
|
|
then "\\,"
|
|
else empty
|
|
let s2 = if (not (null lst)) && (isQuoted (last lst))
|
|
then "\\,"
|
|
else empty
|
|
return $ "``" <> s1 <> contents <> s2 <> "''"
|
|
inlineToLaTeX Apostrophe = return $ char '\''
|
|
inlineToLaTeX EmDash = return "---"
|
|
inlineToLaTeX EnDash = return "--"
|
|
inlineToLaTeX Ellipses = return "\\ldots{}"
|
|
inlineToLaTeX (Str str) = return $ text $ stringToLaTeX str
|
|
inlineToLaTeX (Math InlineMath str) = return $ char '$' <> text str <> char '$'
|
|
inlineToLaTeX (Math DisplayMath str) = return $ "\\[" <> text str <> "\\]"
|
|
inlineToLaTeX (TeX str) = return $ text str
|
|
inlineToLaTeX (HtmlInline _) = return empty
|
|
inlineToLaTeX (LineBreak) = return "\\\\"
|
|
inlineToLaTeX Space = return space
|
|
inlineToLaTeX (Link txt (src, _)) =
|
|
case txt of
|
|
[Code x] | x == src -> -- autolink
|
|
do modify $ \s -> s{ stUrl = True }
|
|
return $ text $ "\\url{" ++ x ++ "}"
|
|
_ -> do contents <- inlineListToLaTeX $ deVerb txt
|
|
return $ text ("\\href{" ++ src ++ "}{") <> contents <>
|
|
char '}'
|
|
inlineToLaTeX (Image _ (source, _)) = do
|
|
modify $ \s -> s{ stGraphics = True }
|
|
return $ "\\includegraphics" <> braces (text source)
|
|
inlineToLaTeX (Note contents) = do
|
|
modify (\s -> s{stInNote = True})
|
|
contents' <- blockListToLaTeX contents
|
|
modify (\s -> s {stInNote = False})
|
|
-- note: a \n before } is needed when note ends with a Verbatim environment
|
|
return $ "\\footnote" <> braces (nest 2 contents')
|
|
|
|
|
|
citationsToNatbib :: [Citation] -> State WriterState Doc
|
|
citationsToNatbib (one:[])
|
|
= citeCommand c p s k
|
|
where
|
|
Citation { citationId = k
|
|
, citationPrefix = p
|
|
, citationSuffix = s
|
|
, citationMode = m
|
|
}
|
|
= one
|
|
c = case m of
|
|
AuthorInText -> "citet"
|
|
SuppressAuthor -> "citeyearpar"
|
|
NormalCitation -> "citep"
|
|
|
|
citationsToNatbib cits
|
|
| noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits
|
|
= citeCommand "citep" p s ks
|
|
where
|
|
noPrefix = and . map (null . citationPrefix)
|
|
noSuffix = and . map (null . citationSuffix)
|
|
ismode m = and . map (((==) m) . citationMode)
|
|
p = citationPrefix $ head $ cits
|
|
s = citationSuffix $ last $ cits
|
|
ks = intercalate ", " $ map citationId cits
|
|
|
|
citationsToNatbib (c:cs) | citationMode c == AuthorInText = do
|
|
author <- citeCommand "citeauthor" [] [] (citationId c)
|
|
cits <- citationsToNatbib (c { citationMode = SuppressAuthor } : cs)
|
|
return $ author <+> cits
|
|
|
|
citationsToNatbib cits = do
|
|
cits' <- mapM convertOne cits
|
|
return $ text "\\citetext{" <> foldl combineTwo empty cits' <> text "}"
|
|
where
|
|
combineTwo a b | isEmpty a = b
|
|
| otherwise = a <> text "; " <> b
|
|
convertOne Citation { citationId = k
|
|
, citationPrefix = p
|
|
, citationSuffix = s
|
|
, citationMode = m
|
|
}
|
|
= case m of
|
|
AuthorInText -> citeCommand "citealt" p s k
|
|
SuppressAuthor -> citeCommand "citeyear" p s k
|
|
NormalCitation -> citeCommand "citealp" p s k
|
|
|
|
citeCommand :: String -> [Inline] -> [Inline] -> String -> State WriterState Doc
|
|
citeCommand c p s k = do
|
|
args <- citeArguments p s k
|
|
return $ text ("\\" ++ c) <> args
|
|
|
|
citeArguments :: [Inline] -> [Inline] -> String -> State WriterState Doc
|
|
citeArguments p s k = do
|
|
let s' = case s of
|
|
(Str (x:[]) : r) | isPunctuation x -> dropWhile (== Space) r
|
|
(Str (x:xs) : r) | isPunctuation x -> Str xs : r
|
|
_ -> s
|
|
pdoc <- inlineListToLaTeX p
|
|
sdoc <- inlineListToLaTeX s'
|
|
let optargs = case (isEmpty pdoc, isEmpty sdoc) of
|
|
(True, True ) -> empty
|
|
(True, False) -> brackets sdoc
|
|
(_ , _ ) -> brackets pdoc <> brackets sdoc
|
|
return $ optargs <> braces (text k)
|
|
|
|
citationsToBiblatex :: [Citation] -> State WriterState Doc
|
|
citationsToBiblatex (one:[])
|
|
= citeCommand cmd p s k
|
|
where
|
|
Citation { citationId = k
|
|
, citationPrefix = p
|
|
, citationSuffix = s
|
|
, citationMode = m
|
|
} = one
|
|
cmd = case m of
|
|
SuppressAuthor -> "autocite*"
|
|
AuthorInText -> "textcite"
|
|
NormalCitation -> "autocite"
|
|
|
|
citationsToBiblatex (c:cs) = do
|
|
args <- mapM convertOne (c:cs)
|
|
return $ text cmd <> foldl (<>) empty args
|
|
where
|
|
cmd = case citationMode c of
|
|
AuthorInText -> "\\textcites"
|
|
_ -> "\\autocites"
|
|
convertOne Citation { citationId = k
|
|
, citationPrefix = p
|
|
, citationSuffix = s
|
|
}
|
|
= citeArguments p s k
|
|
|
|
citationsToBiblatex _ = return empty
|