Merge branch 'master' into patch-1

4 files changed, 98 insertions, 51 deletions

diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index d85488478..2093be19c 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -58,7 +58,7 @@ import Data.Maybe ( fromMaybe, isJust, isNothing )
 import Data.List.Split ( wordsBy )
 import Data.List ( intercalate, isPrefixOf )
 import Data.Char ( isDigit, isLetter, isAlphaNum )
-import Control.Monad ( guard, mzero, void, unless, mplus )
+import Control.Monad ( guard, mzero, void, unless, mplus, msum )
 import Control.Arrow ((***))
 import Control.Applicative ( (<|>) )
 import Data.Monoid (First (..))
@@ -576,23 +576,23 @@ pPara = do
   return $ B.para contents
 
 pFigure :: PandocMonad m => TagParser m Blocks
-pFigure = do
+pFigure = try $ do
   TagOpen _ _ <- pSatisfy (matchTagOpen "figure" [])
   skipMany pBlank
-  let pImg  = pOptInTag "p" pImage <* skipMany pBlank
-      pCapt = option mempty $ pInTags "figcaption" inline <* skipMany pBlank
-      pImgCapt = do
-        img <- pImg
-        cap <- pCapt
-        return (img, cap)
-      pCaptImg = do
-        cap <- pCapt
-        img <- pImg
-        return (img, cap)
-  (imgMany, caption) <- pImgCapt <|> pCaptImg
+  let pImg  = (\x -> (Just x, Nothing)) <$>
+               (pOptInTag "p" pImage <* skipMany pBlank)
+      pCapt = (\x -> (Nothing, Just x)) <$>
+               (pInTags "figcaption" inline <* skipMany pBlank)
+      pSkip = (Nothing, Nothing) <$ pSatisfy (not . matchTagClose "figure")
+  res <- many (pImg <|> pCapt <|> pSkip)
+  let mbimg = msum $ map fst res
+  let mbcap = msum $ map snd res
   TagClose _ <- pSatisfy (matchTagClose "figure")
-  let (Image attr _ (url, tit)):_ = B.toList imgMany
-  return $ B.para $ B.imageWith attr url ("fig:" ++ tit) caption
+  let caption = fromMaybe mempty mbcap
+  case B.toList <$> mbimg of
+       Just [Image attr _ (url, tit)] ->
+         return $ B.para $ B.imageWith attr url ("fig:" ++ tit) caption
+       _ -> mzero
 
 pCodeBlock :: PandocMonad m => TagParser m Blocks
 pCodeBlock = try $ do
@@ -961,7 +961,7 @@ blockHtmlTags = Set.fromList
     "dir", "div", "dl", "dt", "fieldset", "figcaption", "figure",
     "footer", "form", "h1", "h2", "h3", "h4",
     "h5", "h6", "head", "header", "hgroup", "hr", "html",
-    "isindex", "main", "menu", "noframes", "ol", "output", "p", "pre",
+    "isindex", "main", "menu", "meta", "noframes", "ol", "output", "p", "pre",
     "section", "table", "tbody", "textarea",
     "thead", "tfoot", "ul", "dd",
     "dt", "frameset", "li", "tbody", "td", "tfoot",
@@ -1048,7 +1048,7 @@ x `closes` "p" | x `elem` ["address", "article", "aside", "blockquote",
    "dir", "div", "dl", "fieldset", "footer", "form", "h1", "h2", "h3", "h4",
    "h5", "h6", "header", "hr", "main", "menu", "nav", "ol", "p", "pre", "section",
    "table", "ul"] = True
-"meta" `closes` "meta" = True
+_ `closes` "meta" = True
 "form" `closes` "form" = True
 "label" `closes` "label" = True
 "map" `closes` "map" = True
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 06e112cef..d0e95bd85 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -770,11 +770,13 @@ keyval = try $ do
 keyvals :: PandocMonad m => LP m [(String, String)]
 keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')
 
-accent :: (Char -> String) -> Inlines -> LP m Inlines
-accent f ils =
+accent :: PandocMonad m => Char -> (Char -> String) -> LP m Inlines
+accent c f = try $ do
+  ils <- tok
   case toList ils of
        (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
-       []                -> mzero
+       [Space]           -> return $ str [c]
+       []                -> return $ str [c]
        _                 -> return ils
 
 grave :: Char -> String
@@ -961,6 +963,19 @@ hacek 'Z' = "Ž"
 hacek 'z' = "ž"
 hacek c   = [c]
 
+ogonek :: Char -> String
+ogonek 'a' = "ą"
+ogonek 'e' = "ę"
+ogonek 'o' = "ǫ"
+ogonek 'i' = "į"
+ogonek 'u' = "ų"
+ogonek 'A' = "Ą"
+ogonek 'E' = "Ę"
+ogonek 'I' = "Į"
+ogonek 'O' = "Ǫ"
+ogonek 'U' = "Ų"
+ogonek c   = [c]
+
 breve :: Char -> String
 breve 'A' = "Ă"
 breve 'a' = "ă"
@@ -1275,17 +1290,19 @@ inlineCommands = M.fromList $
   , ("copyright", lit "©")
   , ("textasciicircum", lit "^")
   , ("textasciitilde", lit "~")
-  , ("H", try $ tok >>= accent hungarumlaut)
-  , ("`", option (str "`") $ try $ tok >>= accent grave)
-  , ("'", option (str "'") $ try $ tok >>= accent acute)
-  , ("^", option (str "^") $ try $ tok >>= accent circ)
-  , ("~", option (str "~") $ try $ tok >>= accent tilde)
-  , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
-  , (".", option (str ".") $ try $ tok >>= accent dot)
-  , ("=", option (str "=") $ try $ tok >>= accent macron)
-  , ("c", option (str "c") $ try $ tok >>= accent cedilla)
-  , ("v", option (str "v") $ try $ tok >>= accent hacek)
-  , ("u", option (str "u") $ try $ tok >>= accent breve)
+  , ("H", accent '\779' hungarumlaut)
+  , ("`", accent '`' grave)
+  , ("'", accent '\'' acute)
+  , ("^", accent '^' circ)
+  , ("~", accent '~' tilde)
+  , ("\"", accent '\776' umlaut)
+  , (".", accent '\775' dot)
+  , ("=", accent '\772' macron)
+  , ("c", accent '\807' cedilla)
+  , ("v", accent 'ˇ' hacek)
+  , ("u", accent '\774' breve)
+  , ("k", accent '\808' ogonek)
+  , ("textogonekcentered", accent '\808' ogonek)
   , ("i", lit "i")
   , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState
                             guard $ not inTableCell
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 77f75c8c6..2454057fa 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-
   Copyright (C) 2017 Alexander Krotov <ilabdsf@gmail.com>
 
@@ -32,7 +33,6 @@ TODO:
 - {{{ }}} syntax for <example>
 - Page breaks (five "*")
 - Headings with anchors (make it round trip with Muse writer)
-- Verse markup (">")
 - Org tables
 - table.el tables
 - Images with attributes (floating and width)
@@ -101,6 +101,9 @@ parseBlocks = do
 -- utility functions
 --
 
+eol :: Stream s m Char => ParserT s st m ()
+eol = void newline <|> eof
+
 nested :: PandocMonad m => MuseParser m a -> MuseParser m a
 nested p = do
   nestlevel <- stateMaxNestingLevel <$>  getState
@@ -180,7 +183,9 @@ blockElements = choice [ comment
                        , centerTag
                        , rightTag
                        , quoteTag
+                       , divTag
                        , verseTag
+                       , lineBlock
                        , bulletList
                        , orderedList
                        , definitionList
@@ -194,7 +199,7 @@ comment = try $ do
   char ';'
   space
   many $ noneOf "\n"
-  void newline <|> eof
+  eol
   return mempty
 
 separator :: PandocMonad m => MuseParser m (F Blocks)
@@ -202,7 +207,7 @@ separator = try $ do
   string "----"
   many $ char '-'
   many spaceChar
-  void newline <|> eof
+  eol
   return $ return B.horizontalRule
 
 header :: PandocMonad m => MuseParser m (F Blocks)
@@ -212,8 +217,8 @@ header = try $ do
   getPosition >>= \pos -> guard (st == NullState && q == NoQuote && sourceColumn pos == 1)
   level <- liftM length $ many1 $ char '*'
   guard $ level <= 5
-  skipSpaces
-  content <- trimInlinesF . mconcat <$> manyTill inline newline
+  spaceChar
+  content <- trimInlinesF . mconcat <$> manyTill inline eol
   attr <- registerHeader ("", [], []) (runF content defaultParserState)
   return $ B.headerWith attr level <$> content
 
@@ -245,6 +250,12 @@ rightTag = blockTag id "right"
 quoteTag :: PandocMonad m => MuseParser m (F Blocks)
 quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote"
 
+-- <div> tag is supported by Emacs Muse, but not Amusewiki 2.025
+divTag :: PandocMonad m => MuseParser m (F Blocks)
+divTag = do
+  (attrs, content) <- parseHtmlContentWithAttrs "div" block
+  return $ (B.divWith attrs) <$> mconcat content
+
 verseLine :: PandocMonad m => MuseParser m String
 verseLine = do
   line <- anyLine <|> many1Till anyChar eof
@@ -261,8 +272,7 @@ verseLines = do
 verseTag :: PandocMonad m => MuseParser m (F Blocks)
 verseTag = do
   (_, content) <- htmlElement "verse"
-  parsedContent <- parseFromString verseLines content
-  return parsedContent
+  parseFromString verseLines content
 
 commentTag :: PandocMonad m => MuseParser m (F Blocks)
 commentTag = parseHtmlContent "comment" anyChar >> return mempty
@@ -300,6 +310,26 @@ noteBlock = try $ do
       many1Till block (eof <|> () <$ lookAhead noteMarker)
 
 --
+-- Verse markup
+--
+
+lineVerseLine :: PandocMonad m => MuseParser m String
+lineVerseLine = try $ do
+  char '>'
+  white <- many1 (char ' ' >> pure '\160')
+  rest <- anyLine
+  return $ tail white ++ rest
+
+blanklineVerseLine :: PandocMonad m => MuseParser m Char
+blanklineVerseLine = try $ char '>' >> blankline
+
+lineBlock :: PandocMonad m => MuseParser m (F Blocks)
+lineBlock = try $ do
+  lns <- many1 (pure <$> blanklineVerseLine <|> lineVerseLine)
+  lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns
+  return $ B.lineBlock <$> sequence lns'
+
+--
 -- lists
 --
 
@@ -379,8 +409,8 @@ definitionListItem = try $ do
   pure $ do lineContent' <- lineContent
             pure (B.text term, [lineContent'])
   where
-    termParser = (many1 spaceChar) >> -- Initial space as required by Amusewiki, but not Emacs Muse
-                 (many1Till anyChar $ lookAhead (void (try (spaceChar >> string "::")) <|> void newline))
+    termParser = many1 spaceChar >> -- Initial space as required by Amusewiki, but not Emacs Muse
+                 many1Till anyChar (lookAhead (void (try (spaceChar >> string "::")) <|> void newline))
     endOfInput = try $ skipMany blankline >> skipSpaces >> eof
     twoBlankLines = try $ blankline >> skipMany1 blankline
     newDefinitionListItem = try $ void termParser
@@ -438,10 +468,10 @@ museAppendElement tbl element =
 
 tableCell :: PandocMonad m => MuseParser m (F Blocks)
 tableCell = try $ liftM B.plain . trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd)
-  where cellEnd = try $ void (many1 spaceChar >> char '|') <|> void newline <|> eof
+  where cellEnd = try $ void (many1 spaceChar >> char '|') <|> eol
 
 tableElements :: PandocMonad m => MuseParser m [MuseTableElement]
-tableElements = tableParseElement `sepEndBy1` (void newline <|> eof)
+tableElements = tableParseElement `sepEndBy1` eol
 
 elementsToTable :: [MuseTableElement] -> F MuseTable
 elementsToTable = foldM museAppendElement emptyTable
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 190b065fb..daaeff2f0 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -219,7 +219,6 @@ block = choice [ codeBlock
                , directive
                , anchor
                , comment
-               , include
                , header
                , hrule
                , lineBlock     -- must go before definitionList
@@ -460,16 +459,16 @@ tab-width
 encoding
 -}
 
-include :: PandocMonad m => RSTParser m Blocks
-include = try $ do
-  string ".. include::"
-  skipMany spaceChar
-  f <- trim <$> anyLine
-  fields <- many $ rawFieldListItem 3
+includeDirective :: PandocMonad m
+                 => String -> [(String, String)] -> String
+                 -> RSTParser m Blocks
+includeDirective top fields body = do
+  let f = trim top
+  guard $ not (null f)
+  guard $ null (trim body)
   -- options
   let (startLine :: Maybe Int) = lookup "start-line" fields >>= safeRead
   let (endLine :: Maybe Int) = lookup "end-line" fields >>= safeRead
-  guard $ not (null f)
   oldPos <- getPosition
   oldInput <- getInput
   containers <- stateContainers <$> getState
@@ -501,7 +500,7 @@ include = try $ do
                              Just patt -> drop 1 .
                                             dropWhile (not . (patt `isInfixOf`))
                              Nothing   -> id) $ contentLines'
-  let contents' = unlines contentLines''
+  let contents' = unlines contentLines'' ++ "\n"
   case lookup "code" fields of
        Just lang -> do
          let numberLines = lookup "number-lines" fields
@@ -687,6 +686,7 @@ directive' = do
                         $ lookup "height" fields >>=
                           (lengthToDim . filter (not . isSpace))
   case label of
+        "include" -> includeDirective top fields body'
         "table" -> tableDirective top fields body'
         "list-table" -> listTableDirective top fields body'
         "csv-table" -> csvTableDirective top fields body'