@@ -136,10 +136,11 @@ writeICML opts (Pandoc meta blocks) = do
136136 let colwidth = if writerWrapText opts == WrapAuto
137137 then Just $ writerColumns opts
138138 else Nothing
139− renderMeta f s = fst <$> runStateT (f opts [] s) defaultWriterState
139+ renderBlockMeta f s = fst <$> runStateT (f opts [] s) defaultWriterState
140+ renderInlineMeta f s = fst <$> runStateT (f opts [] "" s) defaultWriterState
140141 metadata <- metaToContext opts
141− (renderMeta blocksToICML)
142− (renderMeta inlinesToICML)
142+ (renderBlockMeta blocksToICML)
143+ (renderInlineMeta inlinesToICML)
143144 meta
144145 (main, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState
145146 let context = defField "body" main
@@ -266,9 +267,17 @@ charStylesToDoc st = vcat $ map makeStyle $ Set.toAscList $ inlineStyles st
266267
267268-- | Escape colon characters as %3a
268269escapeColons :: Text -> Text
269−escapeColons = Text.concatMap $ \x -> case x of
270− ':' -> "%3a"
271− _ -> Text.singleton x
270+escapeColons txt = Text.replace ":" "%3a" txt
271+
272+-- | figure out the link destination for a given URL
273+-- | HyperlinkURLDestination with more than one colon crashes CS6
274+makeDest :: Text -> Doc Text
275+makeDest txt = literal $
276+ if "#" `Text.isPrefixOf` txt
277+ then "HyperlinkTextDestination/" <> escTxt
278+ else "HyperlinkURLDestination/" <> escTxt
279+ where
280+ escTxt = escapeColons $ escapeStringForXML txt
272281
273282-- | Convert a list of (identifier, url) pairs to the ICML listing of hyperlinks.
274283hyperlinksToDoc :: Hyperlink -> Doc Text
@@ -277,13 +286,15 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs
277286 where
278287 hyp (ident, url) = hdest $$ hlink
279288 where
280− hdest = selfClosingTag "HyperlinkURLDestination"
289+ hdest = if "#" `Text.isPrefixOf` url
290+ then empty
291+ else selfClosingTag "HyperlinkURLDestination"
281292 [("Self", "HyperlinkURLDestination/"<>escapeColons url), ("Name","link"), ("DestinationURL",url), ("DestinationUniqueKey","1")] -- HyperlinkURLDestination with more than one colon crashes CS6
282293 hlink = inTags True "Hyperlink" [("Self","uf-"<>tshow ident), ("Name",url),
283294 ("Source","htss-"<>tshow ident), ("Visible","true"), ("DestinationUniqueKey","1")]
284295 $ inTags True "Properties" []
285296 $ inTags False "BorderColor" [("type","enumeration")] (text "Black")
286− $$ inTags False "Destination" [("type","object")] (literal $ "HyperlinkURLDestination/"<>escapeColons (escapeStringForXML url)) -- HyperlinkURLDestination with more than one colon crashes CS6
297+ $$ inTags False "Destination" [("type","object")] (makeDest url)
287298
288299-- | Key for specifying user-defined styles
289300dynamicStyleKey :: Text
@@ -297,16 +308,16 @@ blocksToICML opts style lst = do
297308
298309-- | Convert a Pandoc block element to ICML.
299310blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m (Doc Text)
300−blockToICML opts style (Plain lst) = parStyle opts style lst
311+blockToICML opts style (Plain lst) = parStyle opts style "" lst
301312-- title beginning with fig: indicates that the image is a figure
302313blockToICML opts style (Para img@[Image _ txt (_,Text.stripPrefix "fig:" -> Just _)]) = do
303− figure <- parStyle opts (figureName:style) img
304− caption <- parStyle opts (imgCaptionName:style) txt
314+ figure <- parStyle opts (figureName:style) "" img
315+ caption <- parStyle opts (imgCaptionName:style) "" txt
305316 return $ intersperseBrs [figure, caption]
306−blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) lst
317+blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) "" lst
307318blockToICML opts style (LineBlock lns) =
308319 blockToICML opts style $ linesToPara lns
309−blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) [Str str]
320+blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) "" [Str str]
310321blockToICML _ _ b@(RawBlock f str)
311322 | f == Format "icml" = return $ literal str
312323 | otherwise = do
@@ -316,12 +327,12 @@ blockToICML opts style (BlockQuote blocks) = blocksToICML opts (blockQuoteName:s
316327blockToICML opts style (OrderedList attribs lst) = listItemsToICML opts orderedListName style (Just attribs) lst
317328blockToICML opts style (BulletList lst) = listItemsToICML opts bulletListName style Nothing lst
318329blockToICML opts style (DefinitionList lst) = intersperseBrs `fmap` mapM (definitionListItemToICML opts style) lst
319−blockToICML opts style (Header lvl (_, cls, _) lst) =
330+blockToICML opts style (Header lvl (ident, cls, _) lst) =
320331 let stl = (headerName <> tshow lvl <> unnumbered):style
321332 unnumbered = if "unnumbered" `elem` cls
322333 then " (unnumbered)"
323334 else ""
324− in parStyle opts stl lst
335+ in parStyle opts stl ident lst
325336blockToICML _ _ HorizontalRule = return empty -- we could insert a page break instead
326337blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) =
327338 let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
@@ -366,8 +377,8 @@ blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) =
366377 , ("BodyRowCount", tshow nrRows)
367378 , ("ColumnCount", tshow nrCols)
368379 ] (colDescs $$ cells)
369− liftM2 ($$) tableDoc $ parStyle opts (tableCaptionName:style) caption
370−blockToICML opts style (Div (_, _, kvs) lst) =
380+ liftM2 ($$) tableDoc $ parStyle opts (tableCaptionName:style) "" caption
381+blockToICML opts style (Div (_ident, _, kvs) lst) =
371382 let dynamicStyle = maybeToList $ lookup dynamicStyleKey kvs
372383 in blocksToICML opts (dynamicStyle <> style) lst
373384blockToICML _ _ Null = return empty
@@ -416,61 +427,65 @@ listItemToICML opts style isFirst attribs item =
416427
417428definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text)
418429definitionListItemToICML opts style (term,defs) = do
419− term' <- parStyle opts (defListTermName:style) term
430+ term' <- parStyle opts (defListTermName:style) "" term
420431 defs' <- mapM (blocksToICML opts (defListDefName:style)) defs
421432 return $ intersperseBrs (term' : defs')
422433
423434
424435-- | Convert a list of inline elements to ICML.
425−inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m (Doc Text)
426−inlinesToICML opts style lst = vcat `fmap` mapM (inlineToICML opts style) (mergeStrings opts lst)
436+inlinesToICML :: PandocMonad m => WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
437+inlinesToICML opts style ident lst = vcat `fmap` mapM (inlineToICML opts style ident) (mergeStrings opts lst)
427438
428439-- | Convert an inline element to ICML.
429−inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m (Doc Text)
430−inlineToICML _ style (Str str) = charStyle style $ literal $ escapeStringForXML str
431−inlineToICML opts style (Emph lst) = inlinesToICML opts (emphName:style) lst
432−inlineToICML opts style (Underline lst) = inlinesToICML opts (underlineName:style) lst
433−inlineToICML opts style (Strong lst) = inlinesToICML opts (strongName:style) lst
434−inlineToICML opts style (Strikeout lst) = inlinesToICML opts (strikeoutName:style) lst
435−inlineToICML opts style (Superscript lst) = inlinesToICML opts (superscriptName:style) lst
436−inlineToICML opts style (Subscript lst) = inlinesToICML opts (subscriptName:style) lst
437−inlineToICML opts style (SmallCaps lst) = inlinesToICML opts (smallCapsName:style) lst
438−inlineToICML opts style (Quoted SingleQuote lst) = inlinesToICML opts style $
440+inlineToICML :: PandocMonad m => WriterOptions -> Style -> Text -> Inline -> WS m (Doc Text)
441+inlineToICML _ style ident (Str str) = charStyle style ident $ literal $ escapeStringForXML str
442+inlineToICML opts style ident (Emph lst) = inlinesToICML opts (emphName:style) ident lst
443+inlineToICML opts style ident (Underline lst) = inlinesToICML opts (underlineName:style) ident lst
444+inlineToICML opts style ident (Strong lst) = inlinesToICML opts (strongName:style) ident lst
445+inlineToICML opts style ident (Strikeout lst) = inlinesToICML opts (strikeoutName:style) ident lst
446+inlineToICML opts style ident (Superscript lst) = inlinesToICML opts (superscriptName:style) ident lst
447+inlineToICML opts style ident (Subscript lst) = inlinesToICML opts (subscriptName:style) ident lst
448+inlineToICML opts style ident (SmallCaps lst) = inlinesToICML opts (smallCapsName:style) ident lst
449+inlineToICML opts style ident (Quoted SingleQuote lst) = inlinesToICML opts style ident $
439450 mergeStrings opts $ [Str "‘"] ++ lst ++ [Str "’"]
440−inlineToICML opts style (Quoted DoubleQuote lst) = inlinesToICML opts style $
451+inlineToICML opts style ident (Quoted DoubleQuote lst) = inlinesToICML opts style ident $
441452 mergeStrings opts $ [Str "“"] ++ lst ++ [Str "”"]
442−inlineToICML opts style (Cite _ lst) = inlinesToICML opts (citeName:style) lst
443−inlineToICML _ style (Code _ str) = charStyle (codeName:style) $ literal $ escapeStringForXML str
444−inlineToICML _ style Space = charStyle style space
445−inlineToICML opts style SoftBreak =
453+inlineToICML opts style ident (Cite _ lst) = inlinesToICML opts (citeName:style) ident lst
454+inlineToICML _ style ident (Code _ str) = charStyle (codeName:style) ident $ literal $ escapeStringForXML str
455+inlineToICML _ style ident Space = charStyle style ident space
456+inlineToICML opts style ident SoftBreak =
446457 case writerWrapText opts of
447− WrapAuto -> charStyle style space
448− WrapNone -> charStyle style space
449− WrapPreserve -> charStyle style cr
450−inlineToICML _ style LineBreak = charStyle style $ literal lineSeparator
451−inlineToICML opts style (Math mt str) =
458+ WrapAuto -> charStyle style ident space
459+ WrapNone -> charStyle style ident space
460+ WrapPreserve -> charStyle style ident cr
461+inlineToICML _ style ident LineBreak = charStyle style ident $ literal lineSeparator
462+inlineToICML opts style ident (Math mt str) =
452463 lift (texMathToInlines mt str) >>=
453− (fmap mconcat . mapM (inlineToICML opts style))
454−inlineToICML _ _ il@(RawInline f str)
464+ (fmap mconcat . mapM (inlineToICML opts style ident))
465+inlineToICML _ _ _ il@(RawInline f str)
455466 | f == Format "icml" = return $ literal str
456467 | otherwise = do
457468 report $ InlineNotRendered il
458469 return empty
459−inlineToICML opts style (Link _ lst (url, title)) = do
460− content <- inlinesToICML opts (linkName:style) lst
470+inlineToICML opts style ident (Link _ lst (url, title)) = do
471+ content <- inlinesToICML opts (linkName:style) ident lst
461472 state $ \st ->
462− let ident = if null $ links st
463− then 1::Int
464− else 1 + fst (head $ links st)
465− newst = st{ links = (ident, url):links st }
473+ let link_id = if null $ links st
474+ then 1::Int
475+ else 1 + fst (head $ links st)
476+ newst = st{ links = (link_id, url):links st }
466477 cont = inTags True "HyperlinkTextSource"
467− [("Self","htss-"<>tshow ident), ("Name",title), ("Hidden","false")] content
478+ [("Self","htss-"<>tshow link_id), ("Name",title), ("Hidden","false")] content
468479 in (cont, newst)
469−inlineToICML opts style (Image attr _ target) = imageICML opts style attr target
470−inlineToICML opts style (Note lst) = footnoteToICML opts style lst
471−inlineToICML opts style (Span (_, _, kvs) lst) =
480+inlineToICML opts style _ident (Image attr _ target) = imageICML opts style attr target
481+inlineToICML opts style _ (Note lst) = footnoteToICML opts style lst
482+inlineToICML opts style _ (Span (ident, _, kvs) lst) =
472483 let dynamicStyle = maybeToList $ lookup dynamicStyleKey kvs
473− in inlinesToICML opts (dynamicStyle <> style) lst
484+ in inlinesToICML opts (dynamicStyle <> style) ident lst
485+-- ident will be the id of the span, that we need to use down in the hyperlink setter
486+-- if T.null ident
487+-- then
488+-- else do
474489
475490-- | Convert a list of block elements to an ICML footnote.
476491footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
@@ -503,8 +518,8 @@ intersperseBrs :: [Doc Text] -> Doc Text
503518intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty)
504519
505520-- | Wrap a list of inline elements in an ICML Paragraph Style
506−parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m (Doc Text)
507−parStyle opts style lst =
521+parStyle :: PandocMonad m => WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
522+parStyle opts style ident lst =
508523 let slipIn x y = if Text.null y
509524 then x
510525 else x <> " > " <> y
@@ -523,15 +538,36 @@ parStyle opts style lst =
523538 in ("NumberingStartAt", i) : ats
524539 else [attrs]
525540 in do
526− content <- inlinesToICML opts [] lst
541+ content <- inlinesToICML opts [] ident lst
527542 let cont = inTags True "ParagraphStyleRange" attrs' content
528543 state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st })
529544
545+-- | Create the destination name
546+makeDestName :: Text -> Text
547+makeDestName name = "#" <> Text.replace " " "-" name
548+
549+-- | Create a HyperlinkTextDestination for a given identifier
550+makeLinkDest :: Text -> Doc Text -> Doc Text
551+makeLinkDest ident cont = vcat [
552+ selfClosingTag "HyperlinkTextDestination"
553+ [("Self", "HyperlinkTextDestination/"<>makeDestName ident), ("Name","Destination"), ("DestinationUniqueKey","1")]
554+ , inTagsSimple "Content" $ flush cont
555+ ]
556+
557+-- | Create the markup for the content (incl. named destinations)
558+-- | NOTE: since we have no easy way to get actual named dests, we just create them for any short content blocks
559+makeContent :: Text -> Doc Text -> Doc Text
560+makeContent ident cont
561+ | isEmpty cont = empty
562+ | not (Text.null ident) = makeLinkDest ident cont
563+ | otherwise = inTagsSimple "Content" $ flush cont
564+
530565-- | Wrap a Doc in an ICML Character Style.
531−charStyle :: PandocMonad m => Style -> Doc Text -> WS m (Doc Text)
532−charStyle style content =
566+charStyle :: PandocMonad m => Style -> Text -> Doc Text -> WS m (Doc Text)
567+charStyle style ident content =
533568 let (stlStr, attrs) = styleToStrAttr style
534− doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content
569+ doc = inTags True "CharacterStyleRange" attrs
570+ $ makeContent ident content
535571 in
536572 state $ \st ->
537573 let styles = if Text.null stlStr