diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 79 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Man.hs | 2 |
3 files changed, 79 insertions, 35 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 5e2d7cfee..7d3830a60 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -83,13 +83,18 @@ pandocToConTeXt options (Pandoc meta blocks) = do $ metadata let context' = defField "context-lang" (maybe "" (fromBcp47 . splitBy (=='-')) $ getField "lang" context) - context + $ defField "context-dir" (toContextDir $ getField "dir" context) + $ context return $ if writerStandalone options then renderTemplate' (writerTemplate options) context' else main --- escape things as needed for ConTeXt +toContextDir :: Maybe String -> String +toContextDir (Just "rtl") = "r2l" +toContextDir (Just "ltr") = "l2r" +toContextDir _ = "" +-- | escape things as needed for ConTeXt escapeCharForConTeXt :: WriterOptions -> Char -> String escapeCharForConTeXt opts ch = let ligatures = writerTeXLigatures opts in @@ -151,13 +156,18 @@ blockToConTeXt (CodeBlock _ str) = -- blankline because \stoptyping can't have anything after it, inc. '}' blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline blockToConTeXt (RawBlock _ _ ) = return empty -blockToConTeXt (Div (ident,_,_) bs) = do +blockToConTeXt (Div (ident,_,kvs) bs) = do contents <- blockListToConTeXt bs - if null ident - then return contents - else return $ - ("\\reference" <> brackets (text $ toLabel ident) <> braces empty <> - "%") $$ contents + let contents' = if null ident + then contents + else ("\\reference" <> brackets (text $ toLabel ident) <> + braces empty <> "%") $$ contents + let align dir = blankline <> "\\startalignment[" <> dir <> "]" + $$ contents' $$ "\\stopalignment" <> blankline + return $ case lookup "dir" kvs of + Just "rtl" -> align "righttoleft" + Just "ltr" -> align "lefttoright" + _ -> contents' blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ ("\\startitemize" <> if isTightList lst @@ -335,7 +345,12 @@ inlineToConTeXt (Note contents) = do then text "\\footnote{" <> nest 2 contents' <> char '}' else text "\\startbuffer " <> nest 2 contents' <> text "\\stopbuffer\\footnote{\\getbuffer}" -inlineToConTeXt (Span _ ils) = inlineListToConTeXt ils +inlineToConTeXt (Span (_,_,kvs) ils) = do + contents <- inlineListToConTeXt ils + return $ case lookup "dir" kvs of + Just "rtl" -> braces $ "\\righttoleft " <> contents + Just "ltr" -> braces $ "\\lefttoright " <> contents + _ -> contents -- | Craft the section header, inserting the secton reference, if supplied. sectionHeader :: Attr diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 6a30efbf5..f424d8d4a 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -38,10 +38,11 @@ import Text.Pandoc.Options import Text.Pandoc.Templates import Text.Printf ( printf ) import Network.URI ( isURI, unEscapeString ) +import Data.Aeson (object, (.=)) import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse ) import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, ord ) import Data.Maybe ( fromMaybe ) -import Data.Aeson.Types ( (.:), parseMaybe, withObject ) +import qualified Data.Text as T import Control.Applicative ((<|>)) import Control.Monad.State import qualified Text.Parsec as P @@ -120,7 +121,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do Right r -> r Left _ -> "" case lookup "documentclass" (writerVariables options) `mplus` - parseMaybe (withObject "object" (.: "documentclass")) metadata of + fmap stringify (lookupMeta "documentclass" meta) of Just x | x `elem` bookClasses -> modify $ \s -> s{stBook = True} | otherwise -> return () Nothing | documentClass `elem` bookClasses @@ -179,15 +180,20 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "biblatex" True _ -> id) $ metadata + let toPolyObj lang = object [ "name" .= T.pack name + , "options" .= T.pack opts ] + where + (name, opts) = toPolyglossia lang let lang = maybe [] (splitBy (=='-')) $ getField "lang" context - (polyLang, polyVar) = toPolyglossia lang let context' = defField "babel-lang" (toBabel lang) - $ defField "polyglossia-lang" polyLang - $ defField "polyglossia-variant" polyVar + $ defField "polyglossia-lang" (toPolyObj lang) $ defField "polyglossia-otherlangs" - (maybe [] (map $ fst . toPolyglossia . splitBy (=='-')) $ + (maybe [] (map $ toPolyObj . splitBy (=='-')) $ getField "otherlangs" context) + $ defField "latex-dir-rtl" (case (getField "dir" context)::Maybe String of + Just "rtl" -> True + _ -> False) $ context return $ if writerStandalone options then renderTemplate' template context' @@ -324,14 +330,19 @@ isLineBreakOrSpace _ = False blockToLaTeX :: Block -- ^ Block to convert -> State WriterState Doc blockToLaTeX Null = return empty -blockToLaTeX (Div (identifier,classes,_) bs) = do +blockToLaTeX (Div (identifier,classes,kvs) bs) = do beamer <- writerBeamer `fmap` gets stOptions ref <- toLabel identifier let linkAnchor = if null identifier then empty else "\\hyperdef{}" <> braces (text ref) <> braces ("\\label" <> braces (text ref)) - contents <- blockListToLaTeX bs + contents' <- blockListToLaTeX bs + let align dir = inCmd "begin" dir $$ contents' $$ inCmd "end" dir + let contents = case lookup "dir" kvs of + Just "rtl" -> align "RTL" + Just "ltr" -> align "LTR" + _ -> contents' if beamer && "notes" `elem` classes -- speaker notes then return $ "\\note" <> braces contents else return (linkAnchor $$ contents) @@ -728,10 +739,12 @@ isQuoted _ = False -- | Convert inline element to LaTeX inlineToLaTeX :: Inline -- ^ Inline to convert -> State WriterState Doc -inlineToLaTeX (Span (id',classes,_) ils) = do +inlineToLaTeX (Span (id',classes,kvs) ils) = do let noEmph = "csl-no-emph" `elem` classes let noStrong = "csl-no-strong" `elem` classes let noSmallCaps = "csl-no-smallcaps" `elem` classes + let rtl = ("dir","rtl") `elem` kvs + let ltr = ("dir","ltr") `elem` kvs ref <- toLabel id' let linkAnchor = if null id' then empty @@ -741,7 +754,9 @@ inlineToLaTeX (Span (id',classes,_) ils) = do ((if noEmph then inCmd "textup" else id) . (if noStrong then inCmd "textnormal" else id) . (if noSmallCaps then inCmd "textnormal" else id) . - (if not (noEmph || noStrong || noSmallCaps) + (if rtl then inCmd "RL" else id) . + (if ltr then inCmd "LR" else id) . + (if not (noEmph || noStrong || noSmallCaps || rtl || ltr) then braces else id)) `fmap` inlineListToLaTeX ils inlineToLaTeX (Emph lst) = @@ -985,24 +1000,36 @@ getListingsLanguage [] = Nothing getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs -- Takes a list of the constituents of a BCP 47 language code and --- converts it to a Polyglossia (language, variant) tuple +-- converts it to a Polyglossia (language, options) tuple -- http://mirrors.concertpass.com/tex-archive/macros/latex/contrib/polyglossia/polyglossia.pdf toPolyglossia :: [String] -> (String, String) -toPolyglossia ("de":"AT":_) = ("german", "austrian") -toPolyglossia ("de":"CH":_) = ("german", "swiss") -toPolyglossia ("de":_) = ("german", "") -toPolyglossia ("dsb":_) = ("lsorbian", "") -toPolyglossia ("el":"poly":_) = ("greek", "poly") -toPolyglossia ("en":"AU":_) = ("english", "australian") -toPolyglossia ("en":"CA":_) = ("english", "canadian") -toPolyglossia ("en":"GB":_) = ("english", "british") -toPolyglossia ("en":"NZ":_) = ("english", "newzealand") -toPolyglossia ("en":"UK":_) = ("english", "british") -toPolyglossia ("en":"US":_) = ("english", "american") -toPolyglossia ("grc":_) = ("greek", "ancient") -toPolyglossia ("hsb":_) = ("usorbian", "") -toPolyglossia ("sl":_) = ("slovenian", "") -toPolyglossia x = (commonFromBcp47 x, "") +toPolyglossia ("ar":"DZ":_) = ("arabic", "locale=algeria") +toPolyglossia ("ar":"IQ":_) = ("arabic", "locale=mashriq") +toPolyglossia ("ar":"JO":_) = ("arabic", "locale=mashriq") +toPolyglossia ("ar":"LB":_) = ("arabic", "locale=mashriq") +toPolyglossia ("ar":"LY":_) = ("arabic", "locale=libya") +toPolyglossia ("ar":"MA":_) = ("arabic", "locale=morocco") +toPolyglossia ("ar":"MR":_) = ("arabic", "locale=mauritania") +toPolyglossia ("ar":"PS":_) = ("arabic", "locale=mashriq") +toPolyglossia ("ar":"SY":_) = ("arabic", "locale=mashriq") +toPolyglossia ("ar":"TN":_) = ("arabic", "locale=tunisia") +toPolyglossia ("de":"1901":_) = ("german", "spelling=old") +toPolyglossia ("de":"AT":"1901":_) = ("german", "variant=austrian, spelling=old") +toPolyglossia ("de":"AT":_) = ("german", "variant=austrian") +toPolyglossia ("de":"CH":_) = ("german", "variant=swiss") +toPolyglossia ("de":_) = ("german", "") +toPolyglossia ("dsb":_) = ("lsorbian", "") +toPolyglossia ("el":"poly":_) = ("greek", "variant=poly") +toPolyglossia ("en":"AU":_) = ("english", "variant=australian") +toPolyglossia ("en":"CA":_) = ("english", "variant=canadian") +toPolyglossia ("en":"GB":_) = ("english", "variant=british") +toPolyglossia ("en":"NZ":_) = ("english", "variant=newzealand") +toPolyglossia ("en":"UK":_) = ("english", "variant=british") +toPolyglossia ("en":"US":_) = ("english", "variant=american") +toPolyglossia ("grc":_) = ("greek", "variant=ancient") +toPolyglossia ("hsb":_) = ("usorbian", "") +toPolyglossia ("sl":_) = ("slovenian", "") +toPolyglossia x = (commonFromBcp47 x, "") -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Babel language string. diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index f91367eb9..6b1e42394 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -85,6 +85,8 @@ pandocToMan opts (Pandoc meta blocks) = do let context = defField "body" main $ setFieldsFromTitle $ defField "has-tables" hasTables + $ defField "hyphenate" True + $ defField "pandoc-version" pandocVersion $ metadata if writerStandalone opts then return $ renderTemplate' (writerTemplate opts) context |