diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs index 2a2470209..ccb0ff187 100644 --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} {- | @@ -16,296 +17,251 @@ JIRA: -} module Text.Pandoc.Writers.Jira ( writeJira ) where import Prelude -import Control.Monad.State.Strict +import Control.Monad.Reader (ReaderT, ask, asks, runReaderT) +import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) import Data.Foldable (find) -import Data.Text (Text, pack) -import Text.Pandoc.Class (PandocMonad, report) +import Data.Text (Text) +import Text.Jira.Parser (plainText) +import Text.Jira.Printer (prettyBlocks, prettyInlines) +import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Definition -import Text.Pandoc.Logging (LogMessage (BlockNotRendered, InlineNotRendered)) -import Text.Pandoc.Options (WriterOptions (writerTemplate)) -import Text.Pandoc.Shared (blocksToInlines, linesToPara) +import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText), + WrapOption (..)) +import Text.Pandoc.Shared (linesToPara) import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Math (texMathToInlines) -import Text.Pandoc.Writers.Shared (metaToContext, defField) -import qualified Data.Text as T +import Text.Pandoc.Writers.Shared (defField, metaToContext) import Text.DocLayout (literal, render) - -data WriterState = WriterState - { stNotes :: [Text] -- Footnotes - , stListLevel :: Text -- String at beginning of list items, e.g. "**" - } - --- | Initial writer state -startState :: WriterState -startState = WriterState - { stNotes = [] - , stListLevel = "" - } - -type JiraWriter = StateT WriterState +import qualified Data.Text as T +import qualified Text.Jira.Markup as Jira -- | Convert Pandoc to Jira. writeJira :: PandocMonad m => WriterOptions -> Pandoc -> m Text -writeJira opts document = - evalStateT (pandocToJira opts document) startState +writeJira opts = runDefaultConverter (writerWrapText opts) (pandocToJira opts) + +-- | State to keep track of footnotes. +newtype ConverterState = ConverterState { stNotes :: [Text] } + +-- | Initial converter state. +startState :: ConverterState +startState = ConverterState { stNotes = [] } + +-- | Converter monad +type JiraConverter m = ReaderT WrapOption (StateT ConverterState m) + +-- | Run a converter using the default state +runDefaultConverter :: PandocMonad m + => WrapOption + -> (a -> JiraConverter m Text) + -> a + -> m Text +runDefaultConverter wrap c x = evalStateT (runReaderT (c x) wrap) startState -- | Return Jira representation of document. pandocToJira :: PandocMonad m - => WriterOptions -> Pandoc -> JiraWriter m Text + => WriterOptions -> Pandoc -> JiraConverter m Text pandocToJira opts (Pandoc meta blocks) = do + wrap <- ask metadata <- metaToContext opts - (fmap literal . blockListToJira opts) - (fmap literal . inlineListToJira opts) meta - body <- blockListToJira opts blocks + (fmap literal . runDefaultConverter wrap blockListToJira) + (fmap literal . runDefaultConverter wrap inlineListToJira) meta + body <- blockListToJira blocks notes <- gets $ T.intercalate "\n" . reverse . stNotes - let main = body <> if T.null notes - then mempty - else T.pack "\n\n" <> notes + let main = body <> if T.null notes then mempty else "\n\n" <> notes let context = defField "body" main metadata return $ case writerTemplate opts of Nothing -> main Just tpl -> render Nothing $ renderTemplate tpl context --- | Escape one character as needed for Jira. -escapeCharForJira :: Char -> Text -escapeCharForJira c = - let specialChars = "_*-+~^|!{}[]" :: String - in case c of - '\x2013' -> " -- " - '\x2014' -> " --- " - '\x2026' -> "..." - _ | c `elem` specialChars -> T.cons '\\' (T.singleton c) - _ -> T.singleton c +blockListToJira :: PandocMonad m => [Block] -> JiraConverter m Text +blockListToJira = fmap prettyBlocks . toJiraBlocks --- | Escape string as needed for Jira. -escapeStringForJira :: Text -> Text -escapeStringForJira = T.concatMap escapeCharForJira +inlineListToJira :: PandocMonad m => [Inline] -> JiraConverter m Text +inlineListToJira = fmap prettyInlines . toJiraInlines --- | Create an anchor macro from the given element attributes. -anchor :: Attr -> Text -anchor (ident,_,_) = - if ident == "" - then "" - else "{anchor:" <> ident <> "}" +toJiraBlocks :: PandocMonad m => [Block] -> JiraConverter m [Jira.Block] +toJiraBlocks blocks = do + let convert = \case + BlockQuote bs -> singleton . Jira.BlockQuote + <$> toJiraBlocks bs -- FIXME! + BulletList items -> singleton . Jira.List Jira.CircleBullets + <$> toJiraItems items + CodeBlock attr cs -> toJiraCode attr cs + DefinitionList items -> toJiraDefinitionList items + Div attr bs -> toJiraPanel attr bs + Header lvl attr xs -> toJiraHeader lvl attr xs + HorizontalRule -> return . singleton $ Jira.HorizontalRule + LineBlock xs -> toJiraBlocks [linesToPara xs] + OrderedList _ items -> singleton . Jira.List Jira.Enumeration + <$> toJiraItems items + Para xs -> singleton . Jira.Para <$> toJiraInlines xs + Plain xs -> singleton . Jira.Para <$> toJiraInlines xs + RawBlock fmt cs -> rawBlockToJira fmt cs + Null -> return mempty + Table _ _ _ hd body -> singleton <$> do + headerRow <- if null hd + then Just <$> toRow Jira.HeaderCell hd + else pure Nothing + bodyRows <- mapM (toRow Jira.BodyCell) body + let rows = case headerRow of + Just header -> header : bodyRows + Nothing -> bodyRows + return $ Jira.Table rows + jiraBlocks <- mapM convert blocks + return $ mconcat jiraBlocks --- | Append a newline character unless we are in a list. -appendNewlineUnlessInList :: PandocMonad m - => Text - -> JiraWriter m Text -appendNewlineUnlessInList t = do - listLevel <- gets stListLevel - return (if T.null listLevel then t <> "\n" else t) +toRow :: PandocMonad m + => ([Jira.Block] -> Jira.Cell) + -> [TableCell] + -> JiraConverter m Jira.Row +toRow mkCell cells = Jira.Row <$> + mapM (fmap mkCell . toJiraBlocks) cells --- | Convert Pandoc block element to Jira. -blockToJira :: PandocMonad m - => WriterOptions -- ^ Options - -> Block -- ^ Block element - -> JiraWriter m Text +toJiraItems :: PandocMonad m => [[Block]] -> JiraConverter m [[Jira.Block]] +toJiraItems = mapM toJiraBlocks -blockToJira _ Null = return "" +toJiraCode :: PandocMonad m + => Attr + -> Text + -> JiraConverter m [Jira.Block] +toJiraCode (ident, classes, _attribs) code = do + let lang = case find (\c -> T.toLower c `elem` knownLanguages) classes of + Nothing -> Jira.Language "java" + Just l -> Jira.Language l + let addAnchor b = if T.null ident + then b + else [Jira.Para (singleton (Jira.Anchor ident))] <> b + return . addAnchor . singleton $ Jira.Code lang mempty code -blockToJira opts (Div attr bs) = - (anchor attr <>) <$> blockListToJira opts bs +-- | Creates a Jira definition list +toJiraDefinitionList :: PandocMonad m + => [([Inline], [[Block]])] + -> JiraConverter m [Jira.Block] +toJiraDefinitionList defItems = do + let convertDefItem (term, defs) = do + jiraTerm <- Jira.Para <$> styled Jira.Strong term + jiraDefs <- mconcat <$> mapM toJiraBlocks defs + return $ jiraTerm : jiraDefs + singleton . Jira.List Jira.CircleBullets <$> mapM convertDefItem defItems -blockToJira opts (Plain inlines) = - inlineListToJira opts inlines +-- | Creates a Jira panel +toJiraPanel :: PandocMonad m + => Attr -> [Block] + -> JiraConverter m [Jira.Block] +toJiraPanel attr blocks = do + jiraBlocks <- toJiraBlocks blocks + return $ if attr == nullAttr + then jiraBlocks + else singleton (Jira.Panel [] jiraBlocks) -blockToJira opts (Para inlines) = do - contents <- inlineListToJira opts inlines - appendNewlineUnlessInList contents +-- | Creates a Jira header +toJiraHeader :: PandocMonad m + => Int -> Attr -> [Inline] + -> JiraConverter m [Jira.Block] +toJiraHeader lvl (ident, _, _) inlines = + let anchor = Jira.Anchor ident + in singleton . Jira.Header lvl . (anchor :) <$> toJiraInlines inlines -blockToJira opts (LineBlock lns) = - blockToJira opts $ linesToPara lns +-- | Handles raw block. Jira is included verbatim, everything else is +-- discarded. +rawBlockToJira :: PandocMonad m + => Format -> Text + -> JiraConverter m [Jira.Block] +rawBlockToJira fmt cs = do + rawInlines <- toJiraRaw fmt cs + return $ + if null rawInlines + then mempty + else singleton (Jira.Para rawInlines) -blockToJira _ b@(RawBlock f str) = - if f == Format "jira" - then return str - else "" <$ report (BlockNotRendered b) +toJiraRaw :: PandocMonad m + => Format -> Text -> JiraConverter m [Jira.Inline] +toJiraRaw fmt cs = case fmt of + Format "jira" -> return . singleton $ Jira.Str cs + _ -> return mempty -blockToJira _ HorizontalRule = return "----\n" -blockToJira opts (Header level attr inlines) = do - contents <- inlineListToJira opts inlines - let prefix = "h" <> pack (show level) <> ". " - return $ prefix <> anchor attr <> contents <> "\n" +-- +-- Inlines +-- -blockToJira _ (CodeBlock attr@(_,classes,_) str) = do - let lang = find (\c -> T.toLower c `elem` knownLanguages) classes - let start = case lang of - Nothing -> "{code}" - Just l -> "{code:" <> l <> "}" - let anchorMacro = anchor attr - appendNewlineUnlessInList . T.intercalate "\n" $ - (if anchorMacro == "" then id else (anchorMacro :)) - [start, str, "{code}"] +toJiraInlines :: PandocMonad m => [Inline] -> JiraConverter m [Jira.Inline] +toJiraInlines inlines = do + let convert = \case + Cite _ xs -> toJiraInlines xs + Code _ cs -> return . singleton $ + Jira.Monospaced (escapeSpecialChars cs) + Emph xs -> styled Jira.Emphasis xs + Image _ _ (src, _) -> pure . singleton $ Jira.Image [] (Jira.URL src) + LineBreak -> pure . singleton $ Jira.Linebreak + Link _ xs (tgt, _) -> singleton . flip Jira.Link (Jira.URL tgt) + <$> toJiraInlines xs + Math mtype cs -> mathToJira mtype cs + Note bs -> registerNotes bs + Quoted qt xs -> quotedToJira qt xs + RawInline fmt cs -> toJiraRaw fmt cs + SmallCaps xs -> styled Jira.Strong xs + SoftBreak -> do + preserveBreak <- asks (== WrapPreserve) + pure . singleton $ if preserveBreak + then Jira.Linebreak + else Jira.Space + Space -> pure . singleton $ Jira.Space + Span _attr xs -> toJiraInlines xs + Str s -> pure $ escapeSpecialChars s + Strikeout xs -> styled Jira.Strikeout xs + Strong xs -> styled Jira.Strong xs + Subscript xs -> styled Jira.Subscript xs + Superscript xs -> styled Jira.Superscript xs + jiraInlines <- mapM convert inlines + return $ mconcat jiraInlines -blockToJira opts (BlockQuote [p@(Para _)]) = do - contents <- blockToJira opts p - return ("bq. " <> contents) +singleton :: a -> [a] +singleton = (:[]) -blockToJira opts (BlockQuote blocks) = do - contents <- blockListToJira opts blocks - appendNewlineUnlessInList . T.unlines $ - [ "{quote}", contents, "{quote}"] +styled :: PandocMonad m + => Jira.InlineStyle -> [Inline] + -> JiraConverter m [Jira.Inline] +styled s = fmap (singleton . Jira.Styled s) . toJiraInlines -blockToJira opts (Table _caption _aligns _widths headers rows) = do - headerCells <- mapM blocksToCell headers - bodyRows <- mapM (mapM blocksToCell) rows - let tblHead = headerCellsToRow headerCells - let tblBody = map cellsToRow bodyRows - return $ if all null headers - then T.unlines tblBody - else T.unlines (tblHead : tblBody) - where - blocksToCell :: PandocMonad m => [Block] -> JiraWriter m Text - blocksToCell = inlineListToJira opts . blocksToInlines +-- | Converts a plain text value to Jira inlines, ensuring that all +-- special characters will be handled appropriately. +escapeSpecialChars :: Text -> [Jira.Inline] +escapeSpecialChars t = case plainText t of + Right xs -> xs + Left _ -> singleton $ Jira.Str t - cellsToRow :: [Text] -> Text - cellsToRow cells = "|" <> T.intercalate "|" cells <> "|" +mathToJira :: PandocMonad m + => MathType + -> Text + -> JiraConverter m [Jira.Inline] +mathToJira mtype cs = do + mathInlines <- toJiraInlines =<< texMathToInlines mtype cs + return $ case mtype of + InlineMath -> mathInlines + DisplayMath -> Jira.Linebreak : mathInlines ++ [Jira.Linebreak] - headerCellsToRow :: [Text] -> Text - headerCellsToRow cells = "||" <> T.intercalate "||" cells <> "||" +quotedToJira :: PandocMonad m + => QuoteType + -> [Inline] + -> JiraConverter m [Jira.Inline] +quotedToJira qtype xs = do + let quoteChar = case qtype of + DoubleQuote -> "\"" + SingleQuote -> "'" + let surroundWithQuotes = (Jira.Str quoteChar :) . (++ [Jira.Str quoteChar]) + surroundWithQuotes <$> toJiraInlines xs -blockToJira opts (BulletList items) = - listWithMarker opts items '*' - -blockToJira opts (OrderedList _listAttr items) = - listWithMarker opts items '#' - -blockToJira opts (DefinitionList items) = - blockToJira opts (BulletList (map defToBulletItem items)) - where - defToBulletItem :: ([Inline], [[Block]]) -> [Block] - defToBulletItem (inlns, defs) = - let term = Plain [Strong inlns] - blks = mconcat defs - in term : blks - --- Auxiliary functions for lists: - --- | Create a list using the given character as bullet item marker. -listWithMarker :: PandocMonad m - => WriterOptions - -> [[Block]] - -> Char - -> JiraWriter m Text -listWithMarker opts items marker = do - modify $ \s -> s { stListLevel = stListLevel s `T.snoc` marker } - contents <- mapM (listItemToJira opts) items - modify $ \s -> s { stListLevel = T.init (stListLevel s) } - appendNewlineUnlessInList $ T.intercalate "\n" contents - --- | Convert bullet or ordered list item (list of blocks) to Jira. -listItemToJira :: PandocMonad m - => WriterOptions - -> [Block] - -> JiraWriter m Text -listItemToJira opts items = do - contents <- blockListToJira opts items - marker <- gets stListLevel - return $ marker <> " " <> contents - --- | Convert list of Pandoc block elements to Jira. -blockListToJira :: PandocMonad m - => WriterOptions -- ^ Options - -> [Block] -- ^ List of block elements - -> JiraWriter m Text -blockListToJira opts blocks = - T.intercalate "\n" <$> mapM (blockToJira opts) blocks - --- | Convert list of Pandoc inline elements to Jira. -inlineListToJira :: PandocMonad m - => WriterOptions - -> [Inline] - -> JiraWriter m Text -inlineListToJira opts lst = - T.concat <$> mapM (inlineToJira opts) lst - --- | Convert Pandoc inline element to Jira. -inlineToJira :: PandocMonad m - => WriterOptions - -> Inline - -> JiraWriter m Text - -inlineToJira opts (Span attr lst) = - (anchor attr <>) <$> inlineListToJira opts lst - -inlineToJira opts (Emph lst) = do - contents <- inlineListToJira opts lst - return $ "_" <> contents <> "_" - -inlineToJira opts (Strong lst) = do - contents <- inlineListToJira opts lst - return $ "*" <> contents <> "*" - -inlineToJira opts (Strikeout lst) = do - contents <- inlineListToJira opts lst - return $ "-" <> contents <> "-" - -inlineToJira opts (Superscript lst) = do - contents <- inlineListToJira opts lst - return $ "{^" <> contents <> "^}" - -inlineToJira opts (Subscript lst) = do - contents <- inlineListToJira opts lst - return $ "{~" <> contents <> "~}" - -inlineToJira opts (SmallCaps lst) = inlineListToJira opts lst - -inlineToJira opts (Quoted SingleQuote lst) = do - contents <- inlineListToJira opts lst - return $ "'" <> contents <> "'" - -inlineToJira opts (Quoted DoubleQuote lst) = do - contents <- inlineListToJira opts lst - return $ "\"" <> contents <> "\"" - -inlineToJira opts (Cite _ lst) = inlineListToJira opts lst - -inlineToJira _ (Code attr str) = - return (anchor attr <> "{{" <> str <> "}}") - -inlineToJira _ (Str str) = return $ escapeStringForJira str - -inlineToJira opts (Math InlineMath str) = - lift (texMathToInlines InlineMath str) >>= inlineListToJira opts - -inlineToJira opts (Math DisplayMath str) = do - mathInlines <- lift (texMathToInlines DisplayMath str) - contents <- inlineListToJira opts mathInlines - return $ "\\\\" <> contents <> "\\\\" - -inlineToJira _opts il@(RawInline f str) = - if f == Format "jira" - then return str - else "" <$ report (InlineNotRendered il) - -inlineToJira _ LineBreak = return "\n" - -inlineToJira _ SoftBreak = return " " - -inlineToJira _ Space = return " " - -inlineToJira opts (Link _attr txt (src, _title)) = do - linkText <- inlineListToJira opts txt - return $ T.concat - [ "[" - , if null txt then "" else linkText <> "|" - , src - , "]" - ] - -inlineToJira _opts (Image attr _alt (src, _title)) = - return . T.concat $ [anchor attr, "!", src, "!"] - -inlineToJira opts (Note contents) = do +registerNotes :: PandocMonad m => [Block] -> JiraConverter m [Jira.Inline] +registerNotes contents = do curNotes <- gets stNotes let newnum = length curNotes + 1 - contents' <- blockListToJira opts contents - let thisnote = "[" <> pack (show newnum) <> "] " <> contents' <> "\n" + contents' <- blockListToJira contents + let thisnote = "\\[" <> T.pack (show newnum) <> "] " <> contents' <> "\n" modify $ \s -> s { stNotes = thisnote : curNotes } - return $ "[" <> pack (show newnum) <> "]" + return . singleton . Jira.Str $ + "[" <> T.pack (show newnum) <> "]" -- | Language codes recognized by jira knownLanguages :: [Text] diff --git a/test/tables.jira b/test/tables.jira index a772a7fc5..65550bfaf 100644 --- a/test/tables.jira +++ b/test/tables.jira @@ -1,43 +1,38 @@ Simple table with caption: -||Right||Left||Center||Default|| -|12|12|12|12| -|123|123|123|123| -|1|1|1|1| +| 12 | 12 | 12 | 12 | +| 123 | 123 | 123 | 123 | +| 1 | 1 | 1 | 1 | Simple table without caption: -||Right||Left||Center||Default|| -|12|12|12|12| -|123|123|123|123| -|1|1|1|1| +| 12 | 12 | 12 | 12 | +| 123 | 123 | 123 | 123 | +| 1 | 1 | 1 | 1 | Simple table indented two spaces: -||Right||Left||Center||Default|| -|12|12|12|12| -|123|123|123|123| -|1|1|1|1| +| 12 | 12 | 12 | 12 | +| 123 | 123 | 123 | 123 | +| 1 | 1 | 1 | 1 | Multiline table with caption: -||Centered Header||Left Aligned||Right Aligned||Default aligned|| -|First|row|12.0|Example of a row that spans multiple lines.| -|Second|row|5.0|Here’s another one. Note the blank line between rows.| +| First | row | 12.0 | Example of a row that spans multiple lines. | +| Second | row | 5.0 | Here’s another one. Note the blank line between rows. | Multiline table without caption: -||Centered Header||Left Aligned||Right Aligned||Default aligned|| -|First|row|12.0|Example of a row that spans multiple lines.| -|Second|row|5.0|Here’s another one. Note the blank line between rows.| +| First | row | 12.0 | Example of a row that spans multiple lines. | +| Second | row | 5.0 | Here’s another one. Note the blank line between rows. | Table without column headers: -|12|12|12|12| -|123|123|123|123| -|1|1|1|1| +| 12 | 12 | 12 | 12 | +| 123 | 123 | 123 | 123 | +| 1 | 1 | 1 | 1 | Multiline table without column headers: -|First|row|12.0|Example of a row that spans multiple lines.| -|Second|row|5.0|Here’s another one. Note the blank line between rows.| +| First | row | 12.0 | Example of a row that spans multiple lines. | +| Second | row | 5.0 | Here’s another one. Note the blank line between rows. | diff --git a/test/writer.jira b/test/writer.jira index 59dc6980a..0ccb30305 100644 --- a/test/writer.jira +++ b/test/writer.jira @@ -1,59 +1,43 @@ This is a set of tests for pandoc. Most of them are adapted from John Gruber’s markdown test suite. ---- - h1. {anchor:headers}Headers - h2. {anchor:level-2-with-an-embedded-link}Level 2 with an [embedded link|/url] - h3. {anchor:level-3-with-emphasis}Level 3 with _emphasis_ - h4. {anchor:level-4}Level 4 - h5. {anchor:level-5}Level 5 - h1. {anchor:level-1}Level 1 - h2. {anchor:level-2-with-emphasis}Level 2 with _emphasis_ - h3. {anchor:level-3}Level 3 - with no blank line h2. {anchor:level-2}Level 2 - with no blank line ---- - h1. {anchor:paragraphs}Paragraphs - Here’s a regular paragraph. -In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard\-wrapped line in the middle of a paragraph looked like a list item. +In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard-wrapped line in the middle of a paragraph looked like a list item. -Here’s one with a bullet. \* criminey. +Here’s one with a bullet. * criminey. There should be a hard line break here. ---- - h1. {anchor:block-quotes}Block Quotes - -E\-mail style: +E-mail style: bq. This is a block quote. It is pretty short. - {quote} Code in a block quote: -{code} +{code:java} sub status { print "working"; } {code} - A list: # item one @@ -62,23 +46,17 @@ A list: Nested block quotes: bq. nested - bq. nested - {quote} - - This should not be a block quote: 2 > 1. And a following paragraph. ---- - h1. {anchor:code-blocks}Code Blocks - Code: -{code} +{code:java} ---- (should be four hyphens) sub status { @@ -87,21 +65,16 @@ sub status { this code block is indented by one tab {code} - And: -{code} +{code:java} this code block is indented by two tabs These should not be escaped: \$ \\ \> \[ \{ {code} - ---- - h1. {anchor:lists}Lists - h2. {anchor:unordered}Unordered - Asterisks tight: * asterisk 1 @@ -139,7 +112,6 @@ Minuses loose: * Minus 3 h2. {anchor:ordered}Ordered - Tight: # First @@ -172,7 +144,6 @@ Item 1. graf two. The quick brown fox jumped over the lazy dog’s back. # Item 3. h2. {anchor:nested}Nested - * Tab ** Tab *** Tab @@ -196,14 +167,12 @@ Same thing but with paragraphs: # Third h2. {anchor:tabs-and-spaces}Tabs and spaces - * this is a list item indented with tabs * this is a list item indented with spaces ** this is an example list item indented with tabs ** this is an example list item indented with spaces h2. {anchor:fancy-list-markers}Fancy list markers - # begins with 2 # and now 3 with a continuation @@ -232,9 +201,7 @@ M.A. 2007 B. Williams ---- - h1. {anchor:definition-lists}Definition Lists - Tight using spaces: * *apple* @@ -269,7 +236,7 @@ red fruit contains seeds, crisp, pleasant to taste * *_orange_* orange fruit -{code} +{code:java} { orange code block } {code} bq. orange block quote @@ -303,86 +270,62 @@ orange fruit *# sublist h1. {anchor:html-blocks}HTML Blocks - Simple block on one line: foo + And nested without indentation: foo bar + Interpreted markdown in a table: - - - This is _emphasized_ - And this is *strong* - - - Here’s a simple block: foo This should be a code block, though: -{code} +{code:java}
foo
{code} - As should this: -{code} +{code:java}
foo
{code} - Now, nested: foo -This should just be an HTML comment: +This should just be an HTML comment: Multiline: - - Code block: -{code} +{code:java} {code} - Just plain comment, with trailing spaces on the line: - Code: -{code} +{code:java}
{code} - Hr’s: - - - - - - - - - ---- - h1. {anchor:inline-markup}Inline Markup - This is _emphasized_, and so _is this_. This is *strong*, and so *is this*. @@ -397,20 +340,18 @@ So is *_this_* word. So is *_this_* word. -This is code: {{>}}, {{$}}, {{\}}, {{\$}}, {{}}. +This is code: {{>}}, {{$}}, {{\}}, {{\$}}, {{}}. -This is _strikeout_.- -Superscripts: a{^bc^}d a{^_hello_^} a{^hello there^}. +Superscripts: a{^}bc{^}d a{^}_hello_{^} a{^}hello there{^}. -Subscripts: H{~2~}O, H{~23~}O, H{~many of them~}O. +Subscripts: H{~}2{~}O, H{~}23{~}O, H{~}many of them{~}O. -These should not be superscripts or subscripts, because of the unescaped spaces: a\^b c\^d, a\~b c\~d. +These should not be superscripts or subscripts, because of the unescaped spaces: a^b c^d, a~b c~d. ---- - h1. {anchor:smart-quotes-ellipses-dashes}Smart quotes, ellipses, dashes - "Hello," said the spider. "'Shelob' is my name." 'A', 'B', and 'C' are letters. @@ -421,39 +362,36 @@ h1. {anchor:smart-quotes-ellipses-dashes}Smart quotes, ellipses, dashes Here is some quoted '{{code}}' and a "[quoted link|http://example.com/?foo=1&bar=2]". -Some dashes: one --- two --- three --- four --- five. +Some dashes: one—two — three—four — five. -Dashes between numbers: 5 -- 7, 255 -- 66, 1987 -- 1999. +Dashes between numbers: 5–7, 255–66, 1987–1999. -Ellipses...and...and.... +Ellipses…and…and…. ---- - h1. {anchor:latex}LaTeX - * -* 2 \+ 2 = 4 -* _x_ ∈ _y_ -* _α_ ∧ _ω_ +* 2 + 2 = 4 +* _x_ ∈ {_}y{_} +* _α_ ∧ {_}ω{_} * 223 * _p_\-Tree -* Here’s some display math: \\$$\frac\{d\}\{dx\}f(x)=\lim\_\{h\to 0\}\frac\{f(x\+h)\-f(x)\}\{h\}$$\\ -* Here’s one that has a line break in it: _α_ \+ _ω_ × _x_{^2^}. +* Here’s some display math: +$$\frac{d\}\{dx}f\(x)=\lim\_\{h\to 0\}\frac{f(x+h)-f\(x)\}\{h}$$ + +* Here’s one that has a line break in it: _α_ + {_}ω{_} × {_}x{_}^2^. These shouldn’t be math: * To get the famous equation, write {{$e = mc^2$}}. -* $22,000 is a _lot_ of money. So is $34,000. (It worked if "lot" is emphasized.) -* Shoes ($20) and socks ($5). +* $22,000 is a _lot_ of money. So is $34,000. \(It worked if "lot" is emphasized.) +* Shoes \($20) and socks \($5). * Escaped {{$}}: $73 _this should be emphasized_ 23$. Here’s a LaTeX table: - ---- - h1. {anchor:special-characters}Special Characters - Here is some unicode: * I hat: Î @@ -472,7 +410,7 @@ This & that. 6 > 5. -Backslash: \ +Backslash: \ Backtick: ` @@ -488,11 +426,11 @@ Left bracket: \[ Right bracket: \] -Left paren: ( +Left paren: \( Right paren: ) -Greater\-than: > +Greater-than: > Hash: # @@ -505,11 +443,8 @@ Plus: \+ Minus: \- ---- - h1. {anchor:links}Links - h2. {anchor:explicit}Explicit - Just a [URL|/url/]. [URL and title|/url/]. @@ -522,14 +457,13 @@ Just a [URL|/url/]. [URL and title|/url/] -[with\_underscore|/url/with_underscore] +[with_underscore|/url/with_underscore] [Email link|mailto:nobody@nowhere.net] [Empty|]. h2. {anchor:reference}Reference - Foo [bar|/url/]. With [embedded \[brackets\]|/url/]. @@ -544,16 +478,14 @@ Indented [thrice|/url]. This should \[not\]\[\] be a link. -{code} +{code:java} [not]: /url {code} - Foo [bar|/url/]. Foo [biz|/url/]. h2. {anchor:with-ampersands}With ampersands - Here’s a [link with an ampersand in the URL|http://example.com/?foo=1&bar=2]. Here’s a link with an amersand in the link text: [AT&T|http://att.com/]. @@ -563,64 +495,55 @@ Here’s an [inline link|/script?foo=1&bar=2]. Here’s an [inline link in pointy braces|/script?foo=1&bar=2]. h2. {anchor:autolinks}Autolinks - With an ampersand: [http://example.com/?foo=1&bar=2|http://example.com/?foo=1&bar=2] * In a list? * [http://example.com/|http://example.com/] * It should. -An e\-mail address: [nobody@nowhere.net|mailto:nobody@nowhere.net] +An e-mail address: [nobody@nowhere.net|mailto:nobody@nowhere.net] bq. Blockquoted: [http://example.com/|http://example.com/] +Auto-links should not occur here: {{}} -Auto\-links should not occur here: {{}} - -{code} +{code:java} or here: {code} - ---- - h1. {anchor:images}Images - -From "Voyage dans la Lune" by Georges Melies (1902): +From "Voyage dans la Lune" by Georges Melies \(1902): !lalune.jpg! Here is a movie !movie.jpg! icon. ---- - h1. {anchor:footnotes}Footnotes - Here is a footnote reference,[1] and another.[2] This should _not_ be a footnote reference, because it contains a space.\[\^my note\] Here is an inline note.[3] bq. Notes can go in quotes.[4] - # And in list items.[5] This paragraph should not be part of the note, as it is not indented. -[1] Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document. +\[1] Here is the footnote. It can go anywhere after the footnote reference. It need not be placed at the end of the document. -[2] Here’s the long note. This one contains multiple blocks. +\[2] Here’s the long note. This one contains multiple blocks. -Subsequent blocks are indented to show that they belong to the footnote (as with list items). +Subsequent blocks are indented to show that they belong to the footnote \(as with list items). -{code} +{code:java} { } {code} - If you want, you can indent every line, but you can also be lazy and just indent the first line of each block. -[3] This is _easier_ to type. Inline notes may contain [links|http://google.com] and {{]}} verbatim characters, as well as \[bracketed text\]. +\[3] This is _easier_ to type. Inline notes may contain [links|http://google.com] and {{\]}} verbatim characters, as well as \[bracketed text]. -[4] In quote. +\[4] In quote. -[5] In list. +\[5] In list.