Org reader: allow changing emphasis syntax

The characters allowed before and after emphasis can be configured via
`#+pandoc-emphasis-pre` and `#+pandoc-emphasis-post`, respectively. This
allows to change which strings are recognized as emphasized text on a
per-document or even per-paragraph basis. The allowed characters must be
given as (Haskell) string.

    #+pandoc-emphasis-pre: "-\t ('\"{"
    #+pandoc-emphasis-post: "-\t\n .,:!?;'\")}["

If the argument cannot be read as a string, the default value is
restored.

Closes: #4378
This commit is contained in:
Albert Krewinkel 2018-02-21 08:53:29 +01:00
parent 84db7e492a
commit 00d20ccd09
No known key found for this signature in database
GPG key ID: 388DC0B21F631124
4 changed files with 58 additions and 12 deletions

View file

@ -603,6 +603,8 @@ updatePositions :: PandocMonad m
=> Char => Char
-> OrgParser m Char -> OrgParser m Char
updatePositions c = do updatePositions c = do
st <- getState
let emphasisPreChars = orgStateEmphasisPreChars st
when (c `elem` emphasisPreChars) updateLastPreCharPos when (c `elem` emphasisPreChars) updateLastPreCharPos
when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos
return c return c
@ -681,8 +683,10 @@ emphasisEnd c = try $ do
updateLastStrPos updateLastStrPos
popInlineCharStack popInlineCharStack
return c return c
where acceptablePostChars = where
surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars) acceptablePostChars = do
emphasisPostChars <- orgStateEmphasisPostChars <$> getState
surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)
mathStart :: PandocMonad m => Char -> OrgParser m Char mathStart :: PandocMonad m => Char -> OrgParser m Char
mathStart c = try $ mathStart c = try $
@ -734,14 +738,6 @@ many1TillNOrLessNewlines n p end = try $
-- here (see, e.g., the Emacs Lisp variable `org-emphasis-regexp-components` -- here (see, e.g., the Emacs Lisp variable `org-emphasis-regexp-components`
-- for details). -- for details).
-- | Chars allowed to occur before emphasis (spaces and newlines are ok, too)
emphasisPreChars :: [Char]
emphasisPreChars = "-\t ('\"{"
-- | Chars allowed at after emphasis
emphasisPostChars :: [Char]
emphasisPostChars = "-\t\n .,:!?;'\")}["
-- | Chars not allowed at the (inner) border of emphasis -- | Chars not allowed at the (inner) border of emphasis
emphasisForbiddenBorderChars :: [Char] emphasisForbiddenBorderChars :: [Char]
emphasisForbiddenBorderChars = "\t\n\r " emphasisForbiddenBorderChars = "\t\n\r "

View file

@ -43,6 +43,7 @@ import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Shared (safeRead)
import Control.Monad (mzero, void, when) import Control.Monad (mzero, void, when)
import Data.Char (toLower) import Data.Char (toLower)
@ -154,6 +155,8 @@ optionLine = try $ do
"seq_todo" -> todoSequence >>= updateState . registerTodoSequence "seq_todo" -> todoSequence >>= updateState . registerTodoSequence
"typ_todo" -> todoSequence >>= updateState . registerTodoSequence "typ_todo" -> todoSequence >>= updateState . registerTodoSequence
"macro" -> macroDefinition >>= updateState . registerMacro "macro" -> macroDefinition >>= updateState . registerMacro
"pandoc-emphasis-pre" -> emphChars >>= updateState . setEmphasisPreChar
"pandoc-emphasis-post" -> emphChars >>= updateState . setEmphasisPostChar
_ -> mzero _ -> mzero
addLinkFormat :: Monad m => String addLinkFormat :: Monad m => String
@ -184,6 +187,25 @@ parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r") rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:"")) tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
setEmphasisPreChar :: Maybe [Char] -> OrgParserState -> OrgParserState
setEmphasisPreChar csMb st =
let preChars = case csMb of
Nothing -> orgStateEmphasisPreChars defaultOrgParserState
Just cs -> cs
in st { orgStateEmphasisPreChars = preChars }
setEmphasisPostChar :: Maybe [Char] -> OrgParserState -> OrgParserState
setEmphasisPostChar csMb st =
let postChars = case csMb of
Nothing -> orgStateEmphasisPostChars defaultOrgParserState
Just cs -> cs
in st { orgStateEmphasisPostChars = postChars }
emphChars :: Monad m => OrgParser m (Maybe [Char])
emphChars = do
skipSpaces
safeRead <$> anyLine
inlinesTillNewline :: PandocMonad m => OrgParser m (F Inlines) inlinesTillNewline :: PandocMonad m => OrgParser m (F Inlines)
inlinesTillNewline = do inlinesTillNewline = do
updateLastPreCharPos updateLastPreCharPos

View file

@ -29,6 +29,7 @@ Define the Org-mode parser state.
-} -}
module Text.Pandoc.Readers.Org.ParserState module Text.Pandoc.Readers.Org.ParserState
( OrgParserState (..) ( OrgParserState (..)
, defaultOrgParserState
, OrgParserLocal (..) , OrgParserLocal (..)
, OrgNoteRecord , OrgNoteRecord
, HasReaderOptions (..) , HasReaderOptions (..)
@ -104,6 +105,11 @@ type TodoSequence = [TodoMarker]
data OrgParserState = OrgParserState data OrgParserState = OrgParserState
{ orgStateAnchorIds :: [String] { orgStateAnchorIds :: [String]
, orgStateEmphasisCharStack :: [Char] , orgStateEmphasisCharStack :: [Char]
, orgStateEmphasisPreChars :: [Char] -- ^ Chars allowed to occur before
-- emphasis; spaces and newlines are
-- always ok in addition to what is
-- specified here.
, orgStateEmphasisPostChars :: [Char] -- ^ Chars allowed at after emphasis
, orgStateEmphasisNewlines :: Maybe Int , orgStateEmphasisNewlines :: Maybe Int
, orgStateExportSettings :: ExportSettings , orgStateExportSettings :: ExportSettings
, orgStateHeaderMap :: M.Map Inlines String , orgStateHeaderMap :: M.Map Inlines String
@ -124,7 +130,9 @@ data OrgParserState = OrgParserState
, orgMacros :: M.Map Text Macro , orgMacros :: M.Map Text Macro
} }
data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext } data OrgParserLocal = OrgParserLocal
{ orgLocalQuoteContext :: QuoteContext
}
instance Default OrgParserLocal where instance Default OrgParserLocal where
def = OrgParserLocal NoQuote def = OrgParserLocal NoQuote
@ -168,6 +176,8 @@ instance Default OrgParserState where
defaultOrgParserState :: OrgParserState defaultOrgParserState :: OrgParserState
defaultOrgParserState = OrgParserState defaultOrgParserState = OrgParserState
{ orgStateAnchorIds = [] { orgStateAnchorIds = []
, orgStateEmphasisPreChars = "-\t ('\"{"
, orgStateEmphasisPostChars = "-\t\n .,:!?;'\")}["
, orgStateEmphasisCharStack = [] , orgStateEmphasisCharStack = []
, orgStateEmphasisNewlines = Nothing , orgStateEmphasisNewlines = Nothing
, orgStateExportSettings = def , orgStateExportSettings = def

View file

@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Tests.Readers.Org.Meta (tests) where module Tests.Readers.Org.Meta (tests) where
import Test.Tasty (TestTree) import Test.Tasty (TestTree, testGroup)
import Tests.Helpers ((=?>)) import Tests.Helpers ((=?>))
import Tests.Readers.Org.Shared ((=:), spcSep) import Tests.Readers.Org.Shared ((=:), spcSep)
import Text.Pandoc import Text.Pandoc
@ -170,4 +170,22 @@ tests =
, "[[expl:foo][bar]]" , "[[expl:foo][bar]]"
] =?> ] =?>
para (link "http://example.com/foo" "" "bar") para (link "http://example.com/foo" "" "bar")
, testGroup "emphasis config"
[ "Changing pre and post chars for emphasis" =:
T.unlines [ "#+pandoc-emphasis-pre: \"[)\""
, "#+pandoc-emphasis-post: \"]\\n\""
, "([/emph/])*foo*"
] =?>
para ("([" <> emph "emph" <> "])" <> strong "foo")
, "setting an invalid value restores the default" =:
T.unlines [ "#+pandoc-emphasis-pre: \"[\""
, "#+pandoc-emphasis-post: \"]\""
, "#+pandoc-emphasis-pre:"
, "#+pandoc-emphasis-post:"
, "[/noemph/]"
] =?>
para ("[/noemph/]")
]
] ]