f7b705b · typeable/pandoc

git.iko.soy/typeable/pandoc

Implemented implicit reference-style links to section headers in markdown.

For example, if you have a header '# Supported architectures', you can link to it with '[Supported architectures]'. If there are multiple headers with this label, the link will point to the first of them. Implicit references are always overridden by explicitly specified references. Addresses Issue #20. + Moved isPunctuation, uniqueIdentifiers, and inlineListToIdentifier from Text.Pandoc.Writers.HTML to Text.Pandoc.Shared. + Added stHeaders to ParserState. This holds a list of header texts used in the document, and is used to construct implicit header references. + In Text.Pandoc.Readers.Markdown, added call to headerReference parser in initial parsing pass, constructing a list of section header labels. This is then passed to uniqueIdentifiers to produce identifiers, and a list of implicit references is constructed. This is added to the end of the explicitly specified references, so it will be overridden by explicitly specified references. All of this processing is skipped if --strict was specified. + Modified documentation in README. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1086 788f1e2b-df1e-0410-8736-df70ead52e1b

commitf7b705b44cfff881d12501eb8061ebdf20627632 authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> dateThu 22 Nov 2007, 17:14 (19 years ago) parent8d334b8

4 files changed+170−127

compare with master

unifiedsplit

README+23−3 src/Text/Pandoc/Readers/Markdown.hs+94−75 src/Text/Pandoc/Shared.hs+53−3 src/Text/Pandoc/Writers/HTML.hs−46

README+23−3

@@ -299,7 +299,7 @@ For further documentation, see the `pandoc(1)` man page.

299299: includes *string* as a prefix at the beginning of the title that

300300 appears in the HTML header (but not in the title as it appears at

301301 the beginning of the HTML body). (See below on

302− [Title Blocks](#title-blocks).)

302+ [Title Blocks].)

303303

304304`-S` or `--smart`

305305: causes `pandoc` to produce typographically correct output, along the

@@ -797,8 +797,28 @@ another. A link to this section, for example, might look like this:

797797

798798 See the section on [header identifiers](#header-identifiers-in-html).

799799

800−Note, however, that this method of providing links to sections works

801−only in HTML.

800+Note that this method of providing links to sections works only in

801+HTML.

802+

803+Shortcut links to section headers

804+---------------------------------

805+

806+You may use the following shortcut to link to a section header:

807+

808+ See the section on [Header identifiers in HTML].

809+

810+Pandoc will behave as if the document contains

811+

812+ [Header identifiers in HTML]: #header-identifiers-in-html

813+

814+If there are multiple headers labeled "Header identifiers in HTML",

815+this will link to the first one. Note that implicit references are always

816+overridden by explicit ones, so the link in the following text

817+will be to `/url`, not `#header-identifiers-in-html`:

818+

819+ See the section on [Header identifiers in HTML].

820+

821+ [Header identifiers in HTML]: /url

802822

803823Box-style blockquotes

804824---------------------

src/Text/Pandoc/Readers/Markdown.hs+94−75

@@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

1919{- |

2020 Module : Text.Pandoc.Readers.Markdown

22− License : GNU GPL, version 2 or above

22+ License : GNU GPL, version 2 or above

2323

2424 Maintainer : John MacFarlane <jgm@berkeley.edu>

2525 Stability : alpha

@@ -27,8 +27,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

2727

2828Conversion of markdown-formatted plain text to 'Pandoc' document.

2929-}

30−module Text.Pandoc.Readers.Markdown (

31− readMarkdown

30+module Text.Pandoc.Readers.Markdown (

31+ readMarkdown

3232 ) where

3333

3434import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy )

@@ -36,9 +36,9 @@ import Data.Ord ( comparing )

3636import Data.Char ( isAlphaNum )

3737import Network.URI ( isURI )

3838import Text.Pandoc.Definition

39−import Text.Pandoc.Shared

39+import Text.Pandoc.Shared

4040import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )

41−import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,

41+import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,

4242 anyHtmlInlineTag, anyHtmlTag,

4343 anyHtmlEndTag, htmlEndTag, extractTagType,

4444 htmlBlockElement )

@@ -68,14 +68,14 @@ specialChars = "\\[]*_~`<>$!^-.&'\"\8216\8217\8220\8221"

6868indentSpaces = try $ do

6969 state <- getState

7070 let tabStop = stateTabStop state

71− try (count tabStop (char ' ')) <|>

71+ try (count tabStop (char ' ')) <|>

7272 (many (char ' ') >> string "\t") <?> "indentation"

7373

7474nonindentSpaces = do

7575 state <- getState

7676 let tabStop = stateTabStop state

7777 sps <- many (char ' ')

78− if length sps < tabStop

78+ if length sps < tabStop

7979 then return sps

8080 else unexpected "indented line"

8181

@@ -90,8 +90,8 @@ failUnlessSmart = do

9090 if stateSmart state then return () else fail "Smart typography feature"

9191

9292-- | Parse an inline Str element with a given content.

93−inlineString str = try $ do

94− (Str res) <- inline

93+inlineString str = try $ do

94+ (Str res) <- inline

9595 if res == str then return res else fail $ "unexpected Str content"

9696

9797-- | Parse a sequence of inline elements between a string

@@ -102,9 +102,9 @@ inlinesInBalanced opener closer = try $ do

102102 string opener

103103 result <- manyTill ( (do lookAhead (inlineString opener)

104104 -- because it might be a link...

105− bal <- inlinesInBalanced opener closer

105+ bal <- inlinesInBalanced opener closer

106106 return $ [Str opener] ++ bal ++ [Str closer])

107− <|> (count 1 inline))

107+ <|> (count 1 inline))

108108 (try (string closer))

109109 return $ concat result

110110

@@ -114,7 +114,7 @@ inlinesInBalanced opener closer = try $ do

114114

115115titleLine = try $ char '%' >> skipSpaces >> manyTill inline newline

116116

117−authorsLine = try $ do

117+authorsLine = try $ do

118118 char '%'

119119 skipSpaces

120120 authors <- sepEndBy (many1 (noneOf ",;\n")) (oneOf ",;")

@@ -142,15 +142,24 @@ parseMarkdown = do

142142 startPos <- getPosition

143143 -- go through once just to get list of reference keys

144144 -- docMinusKeys is the raw document with blanks where the keys were...

145− docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>=

146− return . concat

145+ docMinusKeys <- manyTill (referenceKey <|> headerReference <|>

146+ lineClump) eof >>= return . concat

147147 setInput docMinusKeys

148148 setPosition startPos

149149 st <- getState

150+ -- get headers and construct implicit references unless strict

151+ if stateStrict st

152+ then return ()

153+ else do let oldkeys = stateKeys st

154+ let headers = reverse $ stateHeaders st

155+ let idents = uniqueIdentifiers headers

156+ let implicitRefs = zipWith (\hd ident -> (hd, ("#" ++ ident, "")))

157+ headers idents

158+ updateState $ \st -> st { stateKeys = oldkeys ++ implicitRefs }

150159 -- go through again for notes unless strict...

151160 if stateStrict st

152161 then return ()

153− else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=

162+ else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=

154163 return . concat

155164 st <- getState

156165 let reversedNotes = stateNotes st

@@ -159,10 +168,10 @@ parseMarkdown = do

159168 setPosition startPos

160169 -- now parse it for real...

161170 (title, author, date) <- option ([],[],"") titleBlock

162− blocks <- parseBlocks

171+ blocks <- parseBlocks

163172 return $ Pandoc (Meta title author date) $ filter (/= Null) blocks

164173

165−--

174+--

166175-- initial pass for references and notes

167176--

168177

@@ -185,7 +194,17 @@ referenceKey = try $ do

185194 -- return blanks so line count isn't affected

186195 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

187196

188−referenceTitle = try $ do

197+headerReference = try $ do

198+ failIfStrict

199+ startPos <- getPosition

200+ (Header level text) <- lookAhead $ atxHeader <|> setextHeader

201+ st <- getState

202+ let headers = stateHeaders st

203+ updateState $ \st -> st { stateHeaders = text:headers }

204+ endPos <- getPosition

205+ lineClump -- return the raw header, because we need to parse it later

206+

207+referenceTitle = try $ do

189208 (many1 spaceChar >> option '\n' newline) <|> newline

190209 skipSpaces

191210 tit <- (charsInBalanced '(' ')' >>= return . unwords . words)

@@ -200,7 +219,7 @@ rawLine = do

200219 notFollowedBy blankline

201220 notFollowedBy' noteMarker

202221 contents <- many1 nonEndline

203− end <- option "" (newline >> optional indentSpaces >> return "\n")

222+ end <- option "" (newline >> optional indentSpaces >> return "\n")

204223 return $ contents ++ end

205224

206225rawLines = many1 rawLine >>= return . concat

@@ -229,7 +248,7 @@ noteBlock = try $ do

229248

230249parseBlocks = manyTill block eof

231250

232−block = choice [ header

251+block = choice [ header

233252 , table

234253 , codeBlock

235254 , hrule

@@ -260,7 +279,7 @@ setextHeader = try $ do

260279 -- first, see if this block has any chance of being a setextHeader:

261280 lookAhead (anyLine >> oneOf setextHChars)

262281 text <- many1Till inline newline >>= return . normalizeSpaces

263− level <- choice $ zipWith

282+ level <- choice $ zipWith

264283 (\ch lev -> try (many1 $ char ch) >> blanklines >> return lev)

265284 setextHChars [1..(length setextHChars)]

266285 return $ Header level text

@@ -285,7 +304,7 @@ hrule = try $ do

285304indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")

286305

287306codeBlock = do

288− contents <- many1 (indentedLine <|>

307+ contents <- many1 (indentedLine <|>

289308 try (do b <- blanklines

290309 l <- indentedLine

291310 return $ b ++ l))

@@ -300,7 +319,7 @@ emacsBoxQuote = try $ do

300319 failIfStrict

301320 string ",----"

302321 manyTill anyChar newline

303− raw <- manyTill

322+ raw <- manyTill

304323 (try (char '|' >> optional (char ' ') >> manyTill anyChar newline))

305324 (try (string "`----"))

306325 blanklines

@@ -310,7 +329,7 @@ emailBlockQuoteStart = try $ nonindentSpaces >> char '>' >>~ optional (char ' ')

310329

311330emailBlockQuote = try $ do

312331 emailBlockQuoteStart

313− raw <- sepBy (many (nonEndline <|>

332+ raw <- sepBy (many (nonEndline <|>

314333 (try (endline >> notFollowedBy emailBlockQuoteStart >>

315334 return '\n'))))

316335 (try (newline >> emailBlockQuoteStart))

@@ -318,12 +337,12 @@ emailBlockQuote = try $ do

318337 optional blanklines

319338 return raw

320339

321−blockQuote = do

340+blockQuote = do

322341 raw <- emailBlockQuote <|> emacsBoxQuote

323342 -- parse the extracted block, which may contain various block elements:

324343 contents <- parseFromString parseBlocks $ (joinWithSep "\n" raw) ++ "\n\n"

325344 return $ BlockQuote contents

326−

345+

327346--

328347-- list blocks

329348--

@@ -358,7 +377,7 @@ orderedListStart style delim = try $ do

358377 then do many1 digit

359378 char '.'

360379 return 1

361− else orderedListMarker style delim

380+ else orderedListMarker style delim

362381 if delim == Period && (style == UpperAlpha || (style == UpperRoman &&

363382 num `elem` [1, 5, 10, 50, 100, 500, 1000]))

364383 then char '\t' <|> (spaceChar >> spaceChar)

@@ -382,7 +401,7 @@ rawListItem start = try $ do

382401 blanks <- many blankline

383402 return $ concat result ++ blanks

384403

385−-- continuation of a list item - indented and separated by blankline

404+-- continuation of a list item - indented and separated by blankline

386405-- or (in compact lists) endline.

387406-- note: nested lists are parsed as continuations

388407listContinuation start = try $ do

@@ -398,7 +417,7 @@ listContinuationLine start = try $ do

398417 result <- manyTill anyChar newline

399418 return $ result ++ "\n"

400419

401−listItem start = try $ do

420+listItem start = try $ do

402421 first <- rawListItem start

403422 continuations <- many (listContinuation start)

404423 -- parsing with ListItemState forces markers at beginning of lines to

@@ -418,7 +437,7 @@ orderedList = try $ do

418437 items <- many1 (listItem (orderedListStart style delim))

419438 return $ OrderedList (start, style, delim) $ compactify items

420439

421−bulletList = many1 (listItem bulletListStart) >>=

440+bulletList = many1 (listItem bulletListStart) >>=

422441 return . BulletList . compactify

423442

424443-- definition lists

@@ -459,7 +478,7 @@ definitionList = do

459478-- paragraph block

460479--

461480

462−para = try $ do

481+para = try $ do

463482 result <- many1 inline

464483 newline

465484 blanklines <|> do st <- getState

@@ -468,9 +487,9 @@ para = try $ do

468487 else lookAhead emacsBoxQuote >> return ""

469488 return $ Para $ normalizeSpaces result

470489

471−plain = many1 inline >>= return . Plain . normalizeSpaces

490+plain = many1 inline >>= return . Plain . normalizeSpaces

472491

473−--

492+--

474493-- raw html

475494--

476495

@@ -487,25 +506,25 @@ htmlBlock = do

487506 else rawHtmlBlocks

488507

489508-- True if tag is self-closing

490−isSelfClosing tag =

509+isSelfClosing tag =

491510 isSuffixOf "/>" $ filter (not . (`elem` " \n\t")) tag

492511

493512strictHtmlBlock = try $ do

494− tag <- anyHtmlBlockTag

513+ tag <- anyHtmlBlockTag

495514 let tag' = extractTagType tag

496− if isSelfClosing tag || tag' == "hr"

515+ if isSelfClosing tag || tag' == "hr"

497516 then return tag

498− else do contents <- many (notFollowedBy' (htmlEndTag tag') >>

517+ else do contents <- many (notFollowedBy' (htmlEndTag tag') >>

499518 (htmlElement <|> (count 1 anyChar)))

500519 end <- htmlEndTag tag'

501520 return $ tag ++ concat contents ++ end

502521

503522rawHtmlBlocks = do

504− htmlBlocks <- many1 rawHtmlBlock

523+ htmlBlocks <- many1 rawHtmlBlock

505524 let combined = concatMap (\(RawHtml str) -> str) htmlBlocks

506525 let combined' = if not (null combined) && last combined == '\n'

507− then init combined -- strip extra newline

508− else combined

526+ then init combined -- strip extra newline

527+ else combined

509528 return $ RawHtml combined'

510529

511530--

@@ -516,7 +535,7 @@ rawLaTeXEnvironment' = failIfStrict >> rawLaTeXEnvironment

516535

517536--

518537-- Tables

519−--

538+--

520539

521540-- Parse a dashed line with optional trailing spaces; return its length

522541-- and the length including trailing space.

@@ -525,7 +544,7 @@ dashedLine ch = do

525544 sp <- many spaceChar

526545 return $ (length dashes, length $ dashes ++ sp)

527546

528−-- Parse a table header with dashed lines of '-' preceded by

547+-- Parse a table header with dashed lines of '-' preceded by

529548-- one line of text.

530549simpleTableHeader = try $ do

531550 rawContent <- anyLine

@@ -548,7 +567,7 @@ tableSep = try $ nonindentSpaces >> many1 (dashedLine '-') >> string "\n"

548567rawTableLine indices = do

549568 notFollowedBy' (blanklines <|> tableFooter)

550569 line <- many1Till anyChar newline

551− return $ map removeLeadingTrailingSpace $ tail $

570+ return $ map removeLeadingTrailingSpace $ tail $

552571 splitByIndices (init indices) line

553572

554573-- Parse a table line and return a list of lists of blocks (columns).

@@ -565,8 +584,8 @@ multilineRow indices = do

565584widthsFromIndices :: Int -- Number of columns on terminal

566585 -> [Int] -- Indices

567586 -> [Float] -- Fractional relative sizes of columns

568−widthsFromIndices _ [] = []

569−widthsFromIndices numColumns indices =

587+widthsFromIndices _ [] = []

588+widthsFromIndices numColumns indices =

570589 let lengths = zipWith (-) indices (0:indices)

571590 totLength = sum lengths

572591 quotient = if totLength > numColumns

@@ -605,14 +624,14 @@ simpleTable = tableWith simpleTableHeader tableLine blanklines

605624multilineTable = tableWith multilineTableHeader multilineRow tableFooter

606625

607626multilineTableHeader = try $ do

608− tableSep

627+ tableSep

609628 rawContent <- many1 (notFollowedBy' tableSep >> many1Till anyChar newline)

610629 initSp <- nonindentSpaces

611630 dashes <- many1 (dashedLine '-')

612631 newline

613632 let (lengths, lines) = unzip dashes

614633 let indices = scanl (+) (length initSp) lines

615− let rawHeadsList = transpose $ map

634+ let rawHeadsList = transpose $ map

616635 (\ln -> tail $ splitByIndices (init indices) ln)

617636 rawContent

618637 let rawHeads = map (joinWithSep " ") rawHeadsList

@@ -625,7 +644,7 @@ multilineTableHeader = try $ do

625644alignType :: [String] -> Int -> Alignment

626645alignType [] len = AlignDefault

627646alignType strLst len =

628− let str = head $ sortBy (comparing length) $

647+ let str = head $ sortBy (comparing length) $

629648 map removeTrailingSpace strLst

630649 leftSpace = if null str then False else (str !! 0) `elem` " \t"

631650 rightSpace = length str < len || (str !! (len - 1)) `elem` " \t"

@@ -637,7 +656,7 @@ alignType strLst len =

637656

638657table = failIfStrict >> (simpleTable <|> multilineTable) <?> "table"

639658

640−--

659+--

641660-- inline

642661--

643662

@@ -667,7 +686,7 @@ inline = choice [ str

667686escapedChar = do

668687 char '\\'

669688 state <- getState

670− result <- option '\\' $ if stateStrict state

689+ result <- option '\\' $ if stateStrict state

671690 then oneOf "\\`*_{}[]()>#+-.!~"

672691 else satisfy (not . isAlphaNum)

673692 return $ Str [result]

@@ -681,17 +700,17 @@ ltSign = do

681700

682701specialCharsMinusLt = filter (/= '<') specialChars

683702

684−symbol = do

703+symbol = do

685704 result <- oneOf specialCharsMinusLt

686705 return $ Str [result]

687706

688707-- parses inline code, between n `s and n `s

689−code = try $ do

708+code = try $ do

690709 starts <- many1 (char '`')

691710 skipSpaces

692711 result <- many1Till (many1 (noneOf "`\n") <|> many1 (char '`') <|>

693− (char '\n' >> return " "))

694− (try (skipSpaces >> count (length starts) (char '`') >>

712+ (char '\n' >> return " "))

713+ (try (skipSpaces >> count (length starts) (char '`') >>

695714 notFollowedBy (char '`')))

696715 return $ Code $ removeLeadingTrailingSpace $ concat result

697716

@@ -707,30 +726,30 @@ math = try $ do

707726 return $ TeX ("$" ++ (joinWithSep " " words) ++ "$")

708727

709728emph = ((enclosed (char '*') (char '*') inline) <|>

710− (enclosed (char '_') (char '_' >> notFollowedBy alphaNum) inline)) >>=

729+ (enclosed (char '_') (char '_' >> notFollowedBy alphaNum) inline)) >>=

711730 return . Emph . normalizeSpaces

712731

713−strong = ((enclosed (string "**") (try $ string "**") inline) <|>

732+strong = ((enclosed (string "**") (try $ string "**") inline) <|>

714733 (enclosed (string "__") (try $ string "__") inline)) >>=

715734 return . Strong . normalizeSpaces

716735

717736strikeout = failIfStrict >> enclosed (string "~~") (try $ string "~~") inline >>=

718737 return . Strikeout . normalizeSpaces

719738

720−superscript = failIfStrict >> enclosed (char '^') (char '^')

739+superscript = failIfStrict >> enclosed (char '^') (char '^')

721740 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space

722741 return . Superscript

723742

724743subscript = failIfStrict >> enclosed (char '~') (char '~')

725744 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space

726− return . Subscript

745+ return . Subscript

727746

728−smartPunctuation = failUnlessSmart >>

747+smartPunctuation = failUnlessSmart >>

729748 choice [ quoted, apostrophe, dash, ellipses ]

730749

731750apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe

732751

733−quoted = doubleQuoted <|> singleQuoted

752+quoted = doubleQuoted <|> singleQuoted

734753

735754withQuoteContext context parser = do

736755 oldState <- getState

@@ -746,7 +765,7 @@ singleQuoted = try $ do

746765 withQuoteContext InSingleQuote $ many1Till inline singleQuoteEnd >>=

747766 return . Quoted SingleQuote . normalizeSpaces

748767

749−doubleQuoted = try $ do

768+doubleQuoted = try $ do

750769 doubleQuoteStart

751770 withQuoteContext InDoubleQuote $ many1Till inline doubleQuoteEnd >>=

752771 return . Quoted DoubleQuote . normalizeSpaces

@@ -757,13 +776,13 @@ failIfInQuoteContext context = do

757776 then fail "already inside quotes"

758777 else return ()

759778

760−singleQuoteStart = do

779+singleQuoteStart = do

761780 failIfInQuoteContext InSingleQuote

762− char '\8216' <|>

763− (try $ do char '\''

781+ char '\8216' <|>

782+ (try $ do char '\''

764783 notFollowedBy (oneOf ")!],.;:-? \t\n")

765784 notFollowedBy (try (oneOfStrings ["s","t","m","ve","ll","re"] >>

766− satisfy (not . isAlphaNum)))

785+ satisfy (not . isAlphaNum)))

767786 -- possess/contraction

768787 return '\'')

769788

@@ -807,13 +826,13 @@ endline = try $ do

807826 newline

808827 notFollowedBy blankline

809828 st <- getState

810− if stateStrict st

829+ if stateStrict st

811830 then do notFollowedBy emailBlockQuoteStart

812831 notFollowedBy (char '#') -- atx header

813− else return ()

832+ else return ()

814833 -- parse potential list-starts differently if in a list:

815834 if stateParserContext st == ListItemState

816− then notFollowedBy' (bulletListStart <|>

835+ then notFollowedBy' (bulletListStart <|>

817836 (anyOrderedListStart >> return ()))

818837 else return ()

819838 return Space

@@ -827,7 +846,7 @@ reference = notFollowedBy' (string "[^") >> -- footnote reference

827846 inlinesInBalanced "[" "]" >>= (return . normalizeSpaces)

828847

829848-- source for a link, with optional title

830−source = try $ do

849+source = try $ do

831850 char '('

832851 optional (char '<')

833852 src <- many (noneOf ")> \t\n")

@@ -837,7 +856,7 @@ source = try $ do

837856 char ')'

838857 return (removeTrailingSpace src, tit)

839858

840−linkTitle = try $ do

859+linkTitle = try $ do

841860 (many1 spaceChar >> option '\n' newline) <|> newline

842861 skipSpaces

843862 delim <- char '\'' <|> char '"'

@@ -852,13 +871,13 @@ link = try $ do

852871

853872-- a link like [this][ref] or [this][] or [this]

854873referenceLink label = do

855− ref <- option [] (try (optional (char ' ') >>

874+ ref <- option [] (try (optional (char ' ') >>

856875 optional (newline >> skipSpaces) >> reference))

857876 let ref' = if null ref then label else ref

858877 state <- getState

859878 case lookupKeySrc (stateKeys state) ref' of

860− Nothing -> fail "no corresponding key"

861− Just target -> return target

879+ Nothing -> fail "no corresponding key"

880+ Just target -> return target

862881

863882emailAddress = try $ do

864883 name <- many1 (alphaNum <|> char '+')

@@ -879,7 +898,7 @@ autoLink = try $ do

879898 char '>'

880899 let src' = if "mailto:" `isPrefixOf` src

881900 then drop 7 src

882− else src

901+ else src

883902 st <- getState

884903 return $ if stateStrict st

885904 then Link [Str src'] (src, "")

@@ -910,7 +929,7 @@ rawLaTeXInline' = failIfStrict >> rawLaTeXInline

910929rawHtmlInline' = do

911930 st <- getState

912931 result <- choice $ if stateStrict st

913− then [htmlBlockElement, anyHtmlTag, anyHtmlEndTag]

932+ then [htmlBlockElement, anyHtmlTag, anyHtmlEndTag]

914933 else [htmlBlockElement, anyHtmlInlineTag]

915934 return $ HtmlInline result

916935

src/Text/Pandoc/Shared.hs+53−3

@@ -34,6 +34,7 @@ module Text.Pandoc.Shared (

3434 substitute,

3535 joinWithSep,

3636 -- * Text processing

37+ isPunctuation,

3738 backslashEscapes,

3839 escapeStringUsing,

3940 stripTrailingNewlines,

@@ -91,6 +92,7 @@ module Text.Pandoc.Shared (

9192 Element (..),

9293 hierarchicalize,

9394 isHeaderBlock,

95+ uniqueIdentifiers,

9496 -- * Writer options

9597 WriterOptions (..),

9698 defaultWriterOptions

@@ -102,7 +104,7 @@ import Text.PrettyPrint.HughesPJ ( Doc, fsep, ($$), (<>), empty )

102104import qualified Text.PrettyPrint.HughesPJ as PP

103105import Text.Pandoc.CharacterReferences ( characterReference )

104106import Data.Char ( toLower, toUpper, ord, isLower, isUpper )

105−import Data.List ( find, isPrefixOf )

107+import Data.List ( find, isPrefixOf, intersperse )

106108import Control.Monad ( join )

107109

108110--

@@ -144,6 +146,15 @@ joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst

144146-- Text processing

145147--

146148

149+-- | True if character is a punctuation character (unicode).

150+isPunctuation :: Char -> Bool

151+isPunctuation c =

152+ let c' = ord c

153+ in if c `elem` "!\"'()*,-./:;<>?[\\]`{|}~" || c' >= 0x2000 && c' <= 0x206F ||

154+ c' >= 0xE000 && c' <= 0xE0FF

155+ then True

156+ else False

157+

147158-- | Returns an association list of backslash escapes for the

148159-- designated characters.

149160backslashEscapes :: [Char] -- ^ list of special characters to escape

@@ -566,7 +577,8 @@ data ParserState = ParserState

566577 stateStrict :: Bool, -- ^ Use strict markdown syntax?

567578 stateSmart :: Bool, -- ^ Use smart typography?

568579 stateColumns :: Int, -- ^ Number of columns in terminal

569− stateHeaderTable :: [HeaderType] -- ^ Ordered list of header types used

580+ stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used

581+ stateHeaders :: [[Inline]] -- ^ List of header texts used

570582 }

571583 deriving Show

572584

@@ -585,7 +597,8 @@ defaultParserState =

585597 stateStrict = False,

586598 stateSmart = False,

587599 stateColumns = 80,

588− stateHeaderTable = [] }

600+ stateHeaderTable = [],

601+ stateHeaders = [] }

589602

590603data HeaderType

591604 = SingleHeader Char -- ^ Single line of characters underneath

@@ -787,6 +800,43 @@ isHeaderBlock :: Block -> Bool

787800isHeaderBlock (Header _ _) = True

788801isHeaderBlock _ = False

789802

803+-- | Convert Pandoc inline list to plain text identifier.

804+inlineListToIdentifier :: [Inline] -> String

805+inlineListToIdentifier [] = ""

806+inlineListToIdentifier (x:xs) =

807+ xAsText ++ inlineListToIdentifier xs

808+ where xAsText = case x of

809+ Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $

810+ concat $ intersperse "-" $ words $ map toLower s

811+ Emph lst -> inlineListToIdentifier lst

812+ Strikeout lst -> inlineListToIdentifier lst

813+ Superscript lst -> inlineListToIdentifier lst

814+ Subscript lst -> inlineListToIdentifier lst

815+ Strong lst -> inlineListToIdentifier lst

816+ Quoted _ lst -> inlineListToIdentifier lst

817+ Code s -> s

818+ Space -> "-"

819+ EmDash -> "-"

820+ EnDash -> "-"

821+ Apostrophe -> ""

822+ Ellipses -> ""

823+ LineBreak -> "-"

824+ TeX _ -> ""

825+ HtmlInline _ -> ""

826+ Link lst _ -> inlineListToIdentifier lst

827+ Image lst _ -> inlineListToIdentifier lst

828+ Note _ -> ""

829+

830+-- | Return unique identifiers for list of inline lists.

831+uniqueIdentifiers :: [[Inline]] -> [String]

832+uniqueIdentifiers ls =

833+ let addIdentifier (nonuniqueIds, uniqueIds) l =

834+ let new = inlineListToIdentifier l

835+ matches = length $ filter (== new) nonuniqueIds

836+ new' = new ++ if matches > 0 then ("-" ++ show matches) else ""

837+ in (new:nonuniqueIds, new':uniqueIds)

838+ in reverse $ snd $ foldl addIdentifier ([],[]) ls

839+

790840--

791841-- Writer options

792842--

src/Text/Pandoc/Writers/HTML.hs−46

@@ -193,15 +193,6 @@ obfuscateChar char =

193193obfuscateString :: String -> String

194194obfuscateString = concatMap obfuscateChar . decodeCharacterReferences

195195

196−-- | True if character is a punctuation character (unicode).

197−isPunctuation :: Char -> Bool

198−isPunctuation c =

199− let c' = ord c

200− in if c `elem` "!\"'()*,-./:;<>?[\\]`{|}~" || c' >= 0x2000 && c' <= 0x206F ||

201− c' >= 0xE000 && c' <= 0xE0FF

202− then True

203− else False

204−

205196-- | Add CSS for document header.

206197addToCSS :: String -> State WriterState ()

207198addToCSS item = do

@@ -209,43 +200,6 @@ addToCSS item = do

209200 let current = stCSS st

210201 put $ st {stCSS = S.insert item current}

211202

212−-- | Convert Pandoc inline list to plain text identifier.

213−inlineListToIdentifier :: [Inline] -> String

214−inlineListToIdentifier [] = ""

215−inlineListToIdentifier (x:xs) =

216− xAsText ++ inlineListToIdentifier xs

217− where xAsText = case x of

218− Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $

219− concat $ intersperse "-" $ words $ map toLower s

220− Emph lst -> inlineListToIdentifier lst

221− Strikeout lst -> inlineListToIdentifier lst

222− Superscript lst -> inlineListToIdentifier lst

223− Subscript lst -> inlineListToIdentifier lst

224− Strong lst -> inlineListToIdentifier lst

225− Quoted _ lst -> inlineListToIdentifier lst

226− Code s -> s

227− Space -> "-"

228− EmDash -> "-"

229− EnDash -> "-"

230− Apostrophe -> ""

231− Ellipses -> ""

232− LineBreak -> "-"

233− TeX _ -> ""

234− HtmlInline _ -> ""

235− Link lst _ -> inlineListToIdentifier lst

236− Image lst _ -> inlineListToIdentifier lst

237− Note _ -> ""

238−

239−-- | Return unique identifiers for list of inline lists.

240−uniqueIdentifiers :: [[Inline]] -> [String]

241−uniqueIdentifiers ls =

242− let addIdentifier (nonuniqueIds, uniqueIds) l =

243− let new = inlineListToIdentifier l

244− matches = length $ filter (== new) nonuniqueIds

245− new' = new ++ if matches > 0 then ("-" ++ show matches) else ""

246− in (new:nonuniqueIds, new':uniqueIds)

247− in reverse $ snd $ foldl addIdentifier ([],[]) ls

248−

249203-- | Convert Pandoc block element to HTML.

250204blockToHtml :: WriterOptions -> Block -> State WriterState Html

251205blockToHtml opts Null = return $ noHtml