Merge branch 'master' into groff_reader

1 files changed, 111 insertions, 10 deletions

diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 2edce7deb..ed2c46d7b 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -38,17 +38,27 @@ module Text.Pandoc.Writers.Shared (
                      , resetField
                      , defField
                      , tagWithAttrs
+                     , isDisplayMath
                      , fixDisplayMath
                      , unsmartify
+                     , hasSimpleCells
                      , gridTable
-                     , metaValueToInlines
+                     , lookupMetaBool
+                     , lookupMetaBlocks
+                     , lookupMetaInlines
+                     , lookupMetaString
                      , stripLeadingTrailingSpace
+                     , groffEscape
+                     , toSubscript
+                     , toSuperscript
                      )
 where
 import Prelude
 import Control.Monad (zipWithM)
+import Data.Monoid (Any (..))
 import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
                    encode, fromJSON)
+import Data.Char (chr, ord, isAscii, isSpace)
 import qualified Data.HashMap.Strict as H
 import Data.List (groupBy, intersperse, transpose)
 import qualified Data.Map as M
@@ -59,9 +69,11 @@ import qualified Text.Pandoc.Builder as Builder
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Pretty
-import Text.Pandoc.Walk (query)
+import Text.Pandoc.Shared (stringify)
 import Text.Pandoc.UTF8 (toStringLazy)
 import Text.Pandoc.XML (escapeStringForXML)
+import Text.Pandoc.Walk (query)
+import Text.Printf (printf)
 
 -- | Create JSON value for template from a 'Meta' and an association list
 -- of variables, specified at the command line or in the writer.
@@ -187,8 +199,9 @@ tagWithAttrs tag (ident,classes,kvs) = hsep
   ] <> ">"
 
 isDisplayMath :: Inline -> Bool
-isDisplayMath (Math DisplayMath _) = True
-isDisplayMath _                    = False
+isDisplayMath (Math DisplayMath _)          = True
+isDisplayMath (Span _ [Math DisplayMath _]) = True
+isDisplayMath _                             = False
 
 stripLeadingTrailingSpace :: [Inline] -> [Inline]
 stripLeadingTrailingSpace = go . reverse . go . reverse
@@ -233,6 +246,21 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs
 unsmartify opts (x:xs) = x : unsmartify opts xs
 unsmartify _ [] = []
 
+-- | True if block is a table that can be represented with
+-- one line per row.
+hasSimpleCells :: Block -> Bool
+hasSimpleCells (Table _caption _aligns _widths headers rows) =
+  all isSimpleCell (concat (headers:rows))
+  where
+    isLineBreak LineBreak = Any True
+    isLineBreak _         = Any False
+    hasLineBreak = getAny . query isLineBreak
+    isSimpleCell [Plain ils] = not (hasLineBreak ils)
+    isSimpleCell [Para ils ] = not (hasLineBreak ils)
+    isSimpleCell []          = True
+    isSimpleCell _           = False
+hasSimpleCells _ = False
+
 gridTable :: Monad m
           => WriterOptions
           -> (WriterOptions -> [Block] -> m Doc)
@@ -332,9 +360,82 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do
            body $$
            border '-' (repeat AlignDefault) widthsInChars
 
-metaValueToInlines :: MetaValue -> [Inline]
-metaValueToInlines (MetaString s)    = [Str s]
-metaValueToInlines (MetaInlines ils) = ils
-metaValueToInlines (MetaBlocks bs)   = query return bs
-metaValueToInlines (MetaBool b)      = [Str $ show b]
-metaValueToInlines _                 = []
+
+
+-- | Retrieve the metadata value for a given @key@
+-- and convert to Bool.
+lookupMetaBool :: String -> Meta -> Bool
+lookupMetaBool key meta =
+  case lookupMeta key meta of
+      Just (MetaBlocks _)     -> True
+      Just (MetaInlines _)    -> True
+      Just (MetaString (_:_)) -> True
+      Just (MetaBool True)    -> True
+      _                       -> False
+
+-- | Retrieve the metadata value for a given @key@
+-- and extract blocks.
+lookupMetaBlocks :: String -> Meta -> [Block]
+lookupMetaBlocks key meta =
+  case lookupMeta key meta of
+         Just (MetaBlocks bs)   -> bs
+         Just (MetaInlines ils) -> [Plain ils]
+         Just (MetaString s)    -> [Plain [Str s]]
+         _                      -> []
+
+-- | Retrieve the metadata value for a given @key@
+-- and extract inlines.
+lookupMetaInlines :: String -> Meta -> [Inline]
+lookupMetaInlines key meta =
+  case lookupMeta key meta of
+         Just (MetaString s)           -> [Str s]
+         Just (MetaInlines ils)        -> ils
+         Just (MetaBlocks [Plain ils]) -> ils
+         Just (MetaBlocks [Para ils])  -> ils
+         _                             -> []
+
+-- | Retrieve the metadata value for a given @key@
+-- and convert to String.
+lookupMetaString :: String -> Meta -> String
+lookupMetaString key meta =
+  case lookupMeta key meta of
+         Just (MetaString s)    -> s
+         Just (MetaInlines ils) -> stringify ils
+         Just (MetaBlocks bs)   -> stringify bs
+         Just (MetaBool b)      -> show b
+         _                      -> ""
+
+-- | Escape non-ASCII characters using groff \u[..] sequences.
+groffEscape :: T.Text -> T.Text
+groffEscape = T.concatMap toUchar
+  where toUchar c
+         | isAscii c = T.singleton c
+         | otherwise = T.pack $ printf "\\[u%04X]" (ord c)
+
+
+toSuperscript :: Char -> Maybe Char
+toSuperscript '1' = Just '\x00B9'
+toSuperscript '2' = Just '\x00B2'
+toSuperscript '3' = Just '\x00B3'
+toSuperscript '+' = Just '\x207A'
+toSuperscript '-' = Just '\x207B'
+toSuperscript '=' = Just '\x207C'
+toSuperscript '(' = Just '\x207D'
+toSuperscript ')' = Just '\x207E'
+toSuperscript c
+  | c >= '0' && c <= '9' =
+                 Just $ chr (0x2070 + (ord c - 48))
+  | isSpace c = Just c
+  | otherwise = Nothing
+
+toSubscript :: Char -> Maybe Char
+toSubscript '+' = Just '\x208A'
+toSubscript '-' = Just '\x208B'
+toSubscript '=' = Just '\x208C'
+toSubscript '(' = Just '\x208D'
+toSubscript ')' = Just '\x208E'
+toSubscript c
+  | c >= '0' && c <= '9' =
+                 Just $ chr (0x2080 + (ord c - 48))
+  | isSpace c = Just c
+  | otherwise = Nothing