diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 14 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Muse.hs | 2 | ||||
| -rw-r--r-- | test/Tests/Readers/Muse.hs | 12 | ||||
| -rw-r--r-- | test/Tests/Writers/Muse.hs | 5 |
4 files changed, 27 insertions, 6 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 1ea78676b..7142c249f 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -31,7 +31,6 @@ Conversion of Muse text to 'Pandoc' document. {- TODO: - Page breaks (five "*") -- Headings with anchors (make it round trip with Muse writer) - Org tables - table.el tables - Images with attributes (floating and width) @@ -241,7 +240,8 @@ header = try $ do guard $ level <= 5 spaceChar content <- trimInlinesF . mconcat <$> manyTill inline eol - attr <- registerHeader ("", [], []) (runF content defaultParserState) + anchorId <- option "" parseAnchor + attr <- registerHeader (anchorId, [], []) (runF content defaultParserState) return $ B.headerWith attr level <$> content example :: PandocMonad m => MuseParser m (F Blocks) @@ -629,14 +629,18 @@ endline = try $ do notFollowedBy blankline returnF B.softbreak -anchor :: PandocMonad m => MuseParser m (F Inlines) -anchor = try $ do +parseAnchor :: PandocMonad m => MuseParser m String +parseAnchor = try $ do getPosition >>= \pos -> guard (sourceColumn pos == 1) char '#' first <- letter rest <- many (letter <|> digit) skipMany spaceChar <|> void newline - let anchorId = first:rest + return $ first:rest + +anchor :: PandocMonad m => MuseParser m (F Inlines) +anchor = try $ do + anchorId <- parseAnchor return $ return $ B.spanWith (anchorId, [], []) mempty footnote :: PandocMonad m => MuseParser m (F Inlines) diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 545891d97..34936504e 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -229,7 +229,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do else "#" <> text ident <> cr let header' = text $ replicate level '*' return $ blankline <> nowrap (header' <> space <> contents) - <> blankline <> attr' + $$ attr' <> blankline -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline blockToMuse (Table caption _ _ headers rows) = do diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 513b54a65..abd230c8c 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -455,6 +455,18 @@ tests = , "</quote>" ] =?> blockQuote (para "* Hi") + , "Headers consume anchors" =: + T.unlines [ "** Foo" + , "#bar" + ] =?> + headerWith ("bar",[],[]) 2 "Foo" + , "Headers don't consume anchors separated with a blankline" =: + T.unlines [ "** Foo" + , "" + , "#bar" + ] =?> + header 2 "Foo" <> + para (spanWith ("bar", [], []) mempty) ] , testGroup "Directives" [ "Title" =: diff --git a/test/Tests/Writers/Muse.hs b/test/Tests/Writers/Muse.hs index 77e741534..e2e6ba06c 100644 --- a/test/Tests/Writers/Muse.hs +++ b/test/Tests/Writers/Muse.hs @@ -234,6 +234,11 @@ tests = [ testGroup "block elements" , "" , "*** Third level" ] + , "heading with ID" =: + headerWith ("bar", [], []) 2 (text "Foo") =?> + unlines [ "** Foo" + , "#bar" + ] ] , "horizontal rule" =: horizontalRule =?> "----" , "escape horizontal rule" =: para (text "----") =?> "<verbatim>----</verbatim>" |