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:
parent
e3dfb2646d
commit
2c1569a0da
1 changed files with 15 additions and 30 deletions
|
@ -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
|
|
||||||
|
|
Loading…
Reference in a new issue