Added support for internal links in ConTeXt writer.

Based on a patch by B. Scott Michel.

Also simplified use of \hyphenateurl. We no longer try to go within
an Inline list to find URLs.  This is resource-heavy, and the main
use case is autolinks, which can be readily recognized.
This commit is contained in:
John MacFarlane 2011-12-30 14:32:49 -08:00
parent e3dfb2646d
commit 2c1569a0da

View file

@ -31,7 +31,7 @@ Conversion of 'Pandoc' format into ConTeXt.
module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Generic (queryWith, bottomUp) import Text.Pandoc.Generic (queryWith)
import Text.Printf ( printf ) import Text.Printf ( printf )
import Data.List ( intercalate ) import Data.List ( intercalate )
import Control.Monad.State import Control.Monad.State
@ -271,35 +271,29 @@ inlineToConTeXt (RawInline "tex" str) = return $ text str
inlineToConTeXt (RawInline _ _) = return empty inlineToConTeXt (RawInline _ _) = return empty
inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr
inlineToConTeXt Space = return space inlineToConTeXt Space = return space
-- ConTeXT has its own way of printing links -- autolink
inlineToConTeXt (Link [Code _ str] (src, tit)) = inlineToConTeXt (Link [Str str] (src, tit)) inlineToConTeXt (Link [Code _ str] (src, tit)) = inlineToConTeXt (Link
[RawInline "context" "\\hyphenatedurl{", Str str, RawInline "context" "}"]
(src, tit))
-- Handle HTML-like internal document references to sections -- Handle HTML-like internal document references to sections
inlineToConTeXt (Link txt (('#' : ref), _)) = do inlineToConTeXt (Link txt (('#' : ref), _)) = do
st <- get opts <- gets stOptions
let opts = stOptions st label <- inlineListToConTeXt txt
let numberedSections = writerNumberSections opts
label <- inlineListToConTeXt $ bottomUp hyphenateURL (normalize txt)
let hasLabel = (not . isEmpty) label
let label' = if hasLabel
then label <+> text "("
else if numberedSections
then text "Section"
else empty
let label'' = braces $ if hasLabel
then text ")"
else empty
return $ text "\\in" return $ text "\\in"
<> braces label' <> braces (if writerNumberSections opts
<> braces label'' then label <+> text "(\\S"
else label) -- prefix
<> braces (if writerNumberSections opts
then text ")"
else empty) -- suffix
<> brackets (text ref) <> brackets (text ref)
-- Convert link's text, hyphenating URLs when they're seen (does deep list inspection)
inlineToConTeXt (Link txt (src, _)) = do inlineToConTeXt (Link txt (src, _)) = do
st <- get st <- get
let next = stNextRef st let next = stNextRef st
put $ st {stNextRef = next + 1} put $ st {stNextRef = next + 1}
let ref = "url" ++ show next let ref = "url" ++ show next
label <- inlineListToConTeXt $ bottomUp hyphenateURL (normalize txt) label <- inlineListToConTeXt txt
return $ "\\useURL" return $ "\\useURL"
<> brackets (text ref) <> brackets (text ref)
<> brackets (text $ escapeStringUsing [('#',"\\#")] src) <> brackets (text $ escapeStringUsing [('#',"\\#")] src)
@ -328,7 +322,7 @@ sectionHeader :: [Char]
-> [Inline] -> [Inline]
-> State WriterState Doc -> State WriterState Doc
sectionHeader ident hdrLevel lst = do sectionHeader ident hdrLevel lst = do
contents <- (inlineListToConTeXt . normalize) lst contents <- inlineListToConTeXt lst
st <- get st <- get
let opts = stOptions st let opts = stOptions st
let level' = if writerChapters opts then hdrLevel - 1 else hdrLevel let level' = if writerChapters opts then hdrLevel - 1 else hdrLevel
@ -343,12 +337,3 @@ sectionHeader ident hdrLevel lst = do
then "\\chapter{" <> contents <> "}" then "\\chapter{" <> contents <> "}"
else contents <> blankline else contents <> blankline
-- | Convert absolute URLs/URIs to ConTeXt raw inlines so that they are hyphenated.
hyphenateURL :: Inline
-> Inline
hyphenateURL x =
case x of
(Str str) -> if isAbsoluteURI str
then (RawInline "context" ("\\hyphenatedurl{" ++ str ++ "}"))
else x
_otherwise -> x