@@ -36,12 +36,13 @@ import Text.Pandoc.Builder (setMeta, fromList)
3636import Text.Pandoc.Shared
3737import Text.Pandoc.Parsing
3838import Text.Pandoc.Options
39−import Control.Monad ( when, liftM, guard, mzero )
39+import Control.Monad ( when, liftM, guard, mzero, mplus )
4040import Data.List ( findIndex, intersperse, intercalate,
4141 transpose, sort, deleteFirstsBy, isSuffixOf )
42+import Data.Maybe (fromMaybe)
4243import qualified Data.Map as M
4344import Text.Printf ( printf )
44−import Control.Applicative ((<$>), (<$), (<*), (*>))
45+import Control.Applicative ((<$>), (<$), (<*), (*>), (<*>))
4546import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
4647import qualified Text.Pandoc.Builder as B
4748import Data.Monoid (mconcat, mempty)
@@ -530,7 +531,7 @@ directive' = do
530531 let body' = body ++ "\n\n"
531532 case label of
532533 "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body)
533− "role" -> return mempty
534+ "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields
534535 "container" -> parseFromString parseBlocks body'
535536 "replace" -> B.para <$> -- consumed by substKey
536537 parseFromString (trimInlines . mconcat <$> many inline)
@@ -591,7 +592,38 @@ directive' = do
591592 Nothing -> B.image src "" alt
592593 _ -> return mempty
593594
594−-- Can contain haracter codes as decimal numbers or
595+-- TODO:
596+-- - Silently ignores illegal fields
597+-- - Silently drops classes
598+-- - Only supports :format: fields with a single format for :raw: roles,
599+-- change Text.Pandoc.Definition.Format to fix
600+addNewRole :: String -> [(String, String)] -> RSTParser Blocks
601+addNewRole roleString fields = do
602+ (role, parentRole) <- parseFromString inheritedRole roleString
603+ customRoles <- stateRstCustomRoles <$> getState
604+ baseRole <- case M.lookup parentRole customRoles of
605+ Just (base, _, _) -> return base
606+ Nothing -> return parentRole
607+
608+ let fmt = if baseRole == "raw" then lookup "format" fields else Nothing
609+ annotate = maybe id addLanguage $
610+ if baseRole == "code"
611+ then lookup "language" fields
612+ else Nothing
613+
614+ updateState $ \s -> s {
615+ stateRstCustomRoles =
616+ M.insert role (baseRole, fmt, (,) parentRole . annotate) customRoles
617+ }
618+
619+ return $ B.singleton Null
620+ where
621+ addLanguage lang (ident, classes, keyValues) =
622+ (ident, "sourceCode" : lang : classes, keyValues)
623+ inheritedRole =
624+ (,) <$> roleNameEndingIn (char '(') <*> roleNameEndingIn (char ')')
625+
626+-- Can contain character codes as decimal numbers or
595627-- hexadecimal numbers, prefixed by 0x, x, \x, U+, u, or \u
596628-- or as XML-style hexadecimal character entities, e.g. ᨫ
597629-- or text, which is used as-is. Comments start with ..
@@ -930,17 +962,56 @@ strong = B.strong . trimInlines . mconcat <$>
930962-- Note, this doesn't precisely implement the complex rule in
931963-- http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html#inline-markup-recognition-rules
932964-- but it should be good enough for most purposes
965+--
966+-- TODO:
967+-- - Classes are silently discarded in addNewRole
968+-- - Lacks sensible implementation for title-reference (which is the default)
969+-- - Allows direct use of the :raw: role, rST only allows inherited use.
933970interpretedRole :: RSTParser Inlines
934971interpretedRole = try $ do
935972 (role, contents) <- roleBefore <|> roleAfter
936− case role of
937− "sup" -> return $ B.superscript $ B.str contents
938− "sub" -> return $ B.subscript $ B.str contents
939− "math" -> return $ B.math contents
940− _ -> return $ B.str contents --unknown
973+ renderRole contents Nothing role nullAttr
974+
975+renderRole :: String -> Maybe String -> String -> Attr -> RSTParser Inlines
976+renderRole contents fmt role attr = case role of
977+ "sup" -> return $ B.superscript $ B.str contents
978+ "superscript" -> return $ B.superscript $ B.str contents
979+ "sub" -> return $ B.subscript $ B.str contents
980+ "subscript" -> return $ B.subscript $ B.str contents
981+ "emphasis" -> return $ B.emph $ B.str contents
982+ "strong" -> return $ B.strong $ B.str contents
983+ "rfc-reference" -> return $ rfcLink contents
984+ "RFC" -> return $ rfcLink contents
985+ "pep-reference" -> return $ pepLink contents
986+ "PEP" -> return $ pepLink contents
987+ "literal" -> return $ B.str contents
988+ "math" -> return $ B.math contents
989+ "title-reference" -> titleRef contents
990+ "title" -> titleRef contents
991+ "t" -> titleRef contents
992+ "code" -> return $ B.codeWith attr contents
993+ "raw" -> return $ B.rawInline (fromMaybe "" fmt) contents
994+ custom -> do
995+ customRole <- stateRstCustomRoles <$> getState
996+ case M.lookup custom customRole of
997+ Just (_, newFmt, inherit) -> let
998+ fmtStr = fmt `mplus` newFmt
999+ (newRole, newAttr) = inherit attr
1000+ in renderRole contents fmtStr newRole newAttr
1001+ Nothing -> return $ B.str contents -- Undefined role
1002+ where
1003+ titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour
1004+ rfcLink rfcNo = B.link rfcUrl ("RFC " ++ rfcNo) $ B.str ("RFC " ++ rfcNo)
1005+ where rfcUrl = "http://www.faqs.org/rfcs/rfc" ++ rfcNo ++ ".html"
1006+ pepLink pepNo = B.link pepUrl ("PEP " ++ pepNo) $ B.str ("PEP " ++ pepNo)
1007+ where padNo = replicate (4 - length pepNo) '0' ++ pepNo
1008+ pepUrl = "http://http://www.python.org/dev/peps/pep-" ++ padNo ++ "/"
1009+
1010+roleNameEndingIn :: RSTParser Char -> RSTParser String
1011+roleNameEndingIn end = many1Till (letter <|> char '-') end
9411012
9421013roleMarker :: RSTParser String
943−roleMarker = char ':' *> many1Till (letter <|> char '-') (char ':')
1014+roleMarker = char ':' *> roleNameEndingIn (char ':')
9441015
9451016roleBefore :: RSTParser (String,String)
9461017roleBefore = try $ do