aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/Muse.hs14
1 files changed, 13 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index 005909ac1..fd72256b2 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -49,6 +49,7 @@ import Control.Monad.State.Strict
import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.Default
import Data.List (intersperse, isInfixOf, transpose)
+import Data.Monoid (Any (..))
import qualified Data.Set as Set
import Data.Text (Text)
import System.FilePath (takeExtension)
@@ -61,6 +62,7 @@ import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
+import Text.Pandoc.Walk
type Notes = [[Block]]
@@ -276,7 +278,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do
-- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors
blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline
blockToMuse (Table caption aligns widths headers rows) =
- if all (== 0.0) widths && length widths > 1
+ if isSimple && numcols > 1
then simpleTable caption headers rows
else do
opts <- asks envOptions
@@ -284,6 +286,16 @@ blockToMuse (Table caption aligns widths headers rows) =
where
blocksToDoc opts blocks =
local (\env -> env { envOptions = opts }) $ blockListToMuse blocks
+ numcols = maximum (length aligns : length widths : map length (headers:rows))
+ hasSimpleCells = all isSimpleCell (concat (headers:rows))
+ isLineBreak LineBreak = Any True
+ isLineBreak _ = Any False
+ hasLineBreak = getAny . query isLineBreak
+ isSimple = hasSimpleCells && all (== 0) widths
+ isSimpleCell [Plain ils] = not (hasLineBreak ils)
+ isSimpleCell [Para ils ] = not (hasLineBreak ils)
+ isSimpleCell [] = True
+ isSimpleCell _ = False
blockToMuse (Div _ bs) = flatBlockListToMuse bs
blockToMuse Null = return empty