Removed readerSmart and the --smart option; added Ext_smart extension.

Now you will need to do

    -f markdown+smart

instead of

    -f markdown --smart

This change opens the way for writers, in addition to readers,
to be sensitive to +smart, but this change hasn't yet been made.

API change. Command-line option change.

Updated manual.
This commit is contained in:
John MacFarlane 2017-01-14 18:27:06 +01:00
parent 3876b91448
commit 6f8b967d98
15 changed files with 55 additions and 69 deletions

View file

@ -394,15 +394,6 @@ Reader options
HTML codes and LaTeX environments. (The LaTeX reader does pass through
untranslatable LaTeX *commands*, even if `-R` is not specified.)
`-S`, `--smart`
: Produce typographically correct output, converting straight quotes
to curly quotes, `---` to em-dashes, `--` to en-dashes, and
`...` to ellipses. Nonbreaking spaces are inserted after certain
abbreviations, such as "Mr." (Note: This option is selected automatically
when the output format is `latex` or `context`, unless `--no-tex-ligatures`
is used. It has no effect for `latex` input.)
`--old-dashes`
: Selects the pandoc <= 1.8.2.1 behavior for parsing smart dashes: `-` before
@ -721,12 +712,12 @@ Options affecting specific writers
than parsing ligatures for quotation marks and dashes. In
writing LaTeX or ConTeXt, print unicode quotation mark and
dash characters literally, rather than converting them to
the standard ASCII TeX ligatures. Note: normally `--smart`
is selected automatically for LaTeX and ConTeXt output, but
it must be specified explicitly if `--no-tex-ligatures` is
the standard ASCII TeX ligatures. Note: normally the `smart`
extension is selected automatically for LaTeX and ConTeXt output,
but it must be specified explicitly if `--no-tex-ligatures` is
selected. If you use literal curly quotes, dashes, and
ellipses in your source, then you may want to use
`--no-tex-ligatures` without `--smart`.
`--no-tex-ligatures` without `+smart`.
`--listings`
@ -2639,20 +2630,6 @@ two trailing spaces on a line.
Backslash escapes do not work in verbatim contexts.
Smart punctuation
-----------------
#### Extension ####
If the `--smart` option is specified, pandoc will produce typographically
correct output, converting straight quotes to curly quotes, `---` to
em-dashes, `--` to en-dashes, and `...` to ellipses. Nonbreaking spaces
are inserted after certain abbreviations, such as "Mr."
Note: if your LaTeX template or any included header file call for the
[`csquotes`] package, pandoc will detect this automatically and use
`\enquote{...}` for quoted text.
Inline formatting
-----------------
@ -3410,6 +3387,20 @@ in pandoc, but may be enabled by adding `+EXTENSION` to the format
name, where `EXTENSION` is the name of the extension. Thus, for
example, `markdown+hard_line_breaks` is Markdown with hard line breaks.
#### Extension: `smart` ####
Produce typographically correct output, converting straight
quotes to curly quotes, `---` to em-dashes, `--` to en-dashes,
and `...` to ellipses. Nonbreaking spaces are inserted after
certain abbreviations, such as "Mr." (Note: This option is
selected automatically when the output format is `latex` or
`context`, unless `--no-tex-ligatures` is used. It has no
effect for `latex` input.)
Note: if your LaTeX template or any included header file call
for the [`csquotes`] package, pandoc will detect this
automatically and use `\enquote{...}` for quoted text.
#### Extension: `angle_brackets_escapable` ####
Allow `<` and `>` to be backslash-escaped, as they can be in

View file

@ -112,7 +112,6 @@ convertWithOpts opts args = do
, optSectionDivs = sectionDivs
, optIncremental = incremental
, optSelfContained = selfContained
, optSmart = smart
, optOldDashes = oldDashes
, optHtml5 = html5
, optHtmlQTags = htmlQTags
@ -212,10 +211,6 @@ convertWithOpts opts args = do
let conTeXtOutput = format == "context"
let html5Output = format == "html5"
let laTeXInput = "latex" `isPrefixOf` readerName' ||
"beamer" `isPrefixOf` readerName'
-- disabling the custom writer for now
writer <- if ".lua" `isSuffixOf` format
-- note: use non-lowercased version writerName
@ -295,11 +290,15 @@ convertWithOpts opts args = do
uriFragment = "" }
_ -> Nothing
let readerOpts = def{ readerSmart = if laTeXInput
then texLigatures
else smart || (texLigatures &&
(laTeXOutput || conTeXtOutput))
, readerStandalone = standalone'
{- TODO - smart is now an extension, but we should prob make
- texligatures one too...
let smartExt = if laTeXInput
then texLigatures
else smart || (texLigatures &&
(laTeXOutput || conTeXtOutput))
-}
let readerOpts = def{ readerStandalone = standalone'
, readerParseRaw = parseRaw
, readerColumns = columns
, readerTabStop = tabStop
@ -547,7 +546,6 @@ data Opt = Opt
, optSectionDivs :: Bool -- ^ Put sections in div tags in HTML
, optIncremental :: Bool -- ^ Use incremental lists in Slidy/Slideous/S5
, optSelfContained :: Bool -- ^ Make HTML accessible offline
, optSmart :: Bool -- ^ Use smart typography
, optOldDashes :: Bool -- ^ Parse dashes like pandoc <=1.8.2.1
, optHtml5 :: Bool -- ^ Produce HTML5 in HTML
, optHtmlQTags :: Bool -- ^ Use <q> tags in HTML
@ -613,7 +611,6 @@ defaultOpts = Opt
, optSectionDivs = False
, optIncremental = False
, optSelfContained = False
, optSmart = False
, optOldDashes = False
, optHtml5 = False
, optHtmlQTags = False
@ -692,15 +689,9 @@ options =
(\opt -> return opt { optParseRaw = True }))
"" -- "Parse untranslatable HTML codes and LaTeX environments as raw"
, Option "S" ["smart"]
(NoArg
(\opt -> return opt { optSmart = True }))
"" -- "Use smart quotes, dashes, and ellipses"
, Option "" ["old-dashes"]
(NoArg
(\opt -> return opt { optSmart = True
, optOldDashes = True }))
(\opt -> return opt { optOldDashes = True }))
"" -- "Use smart quotes, dashes, and ellipses"
, Option "" ["base-header-level"]

View file

@ -336,7 +336,8 @@ getDefaultExtensions "markdown_github" = githubMarkdownExtensions
getDefaultExtensions "markdown" = pandocExtensions
getDefaultExtensions "plain" = plainExtensions
getDefaultExtensions "org" = extensionsFromList
[Ext_citations, Ext_auto_identifiers]
[Ext_citations,
Ext_auto_identifiers]
getDefaultExtensions "textile" = extensionsFromList
[Ext_auto_identifiers]
getDefaultExtensions "html" = extensionsFromList
@ -349,6 +350,12 @@ getDefaultExtensions "epub" = extensionsFromList
Ext_native_divs,
Ext_native_spans,
Ext_epub_html_exts]
getDefaultExtensions "latex" = extensionsFromList
[Ext_smart,
Ext_auto_identifiers]
getDefaultExtensions "context" = extensionsFromList
[Ext_smart,
Ext_auto_identifiers]
getDefaultExtensions _ = extensionsFromList
[Ext_auto_identifiers]

View file

@ -130,6 +130,7 @@ data Extension =
| Ext_line_blocks -- ^ RST style line blocks
| Ext_epub_html_exts -- ^ Recognise the EPUB extended version of HTML
| Ext_shortcut_reference_links -- ^ Shortcut reference links
| Ext_smart -- ^ "Smart" quotes, apostrophes, ellipses, dashes
deriving (Show, Read, Enum, Eq, Ord, Bounded, Data, Typeable, Generic)
pandocExtensions :: Extensions

View file

@ -54,7 +54,6 @@ import GHC.Generics (Generic)
data ReaderOptions = ReaderOptions{
readerExtensions :: Extensions -- ^ Syntax extensions
, readerSmart :: Bool -- ^ Smart punctuation
, readerStandalone :: Bool -- ^ Standalone document with header
, readerParseRaw :: Bool -- ^ Parse raw HTML, LaTeX
, readerColumns :: Int -- ^ Number of columns in terminal
@ -74,7 +73,6 @@ data ReaderOptions = ReaderOptions{
instance Default ReaderOptions
where def = ReaderOptions{
readerExtensions = pandocExtensions
, readerSmart = False
, readerStandalone = False
, readerParseRaw = False
, readerColumns = 80

View file

@ -1105,15 +1105,11 @@ registerHeader (ident,classes,kvs) header' = do
updateState $ updateHeaderMap $ insert' header' ident
return (ident,classes,kvs)
-- | Fail unless we're in "smart typography" mode.
failUnlessSmart :: (Stream s m a, HasReaderOptions st) => ParserT s st m ()
failUnlessSmart = getOption readerSmart >>= guard
smartPunctuation :: (HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
=> ParserT s st m Inlines
-> ParserT s st m Inlines
smartPunctuation inlineParser = do
failUnlessSmart
guardEnabled Ext_smart
choice [ quoted inlineParser, apostrophe, dash, ellipses ]
apostrophe :: Stream s m Char => ParserT s st m Inlines

View file

@ -43,7 +43,7 @@ import Text.Pandoc.Class (PandocMonad)
readCommonMark :: PandocMonad m => ReaderOptions -> String -> m Pandoc
readCommonMark opts s = return $
nodeToPandoc $ commonmarkToNode opts' $ pack s
where opts' = if readerSmart opts
where opts' = if extensionEnabled Ext_smart (readerExtensions opts)
then [optNormalize, optSmart]
else [optNormalize]

View file

@ -187,7 +187,7 @@ mathChars =
quoted' :: PandocMonad m => (Inlines -> Inlines) -> LP m String -> LP m () -> LP m Inlines
quoted' f starter ender = do
startchs <- starter
smart <- getOption readerSmart
smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
if smart
then do
ils <- many (notFollowedBy ender >> inline)
@ -209,7 +209,7 @@ doubleQuote = do
singleQuote :: PandocMonad m => LP m Inlines
singleQuote = do
smart <- getOption readerSmart
smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
if smart
then quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)
<|> quoted' singleQuoted (string "") (try $ char '' >> notFollowedBy letter)

View file

@ -1590,7 +1590,7 @@ code = try $ do
math :: PandocMonad m => MarkdownParser m (F Inlines)
math = (return . B.displayMath <$> (mathDisplay >>= applyMacros'))
<|> (return . B.math <$> (mathInline >>= applyMacros')) <+?>
((getOption readerSmart >>= guard) *> (return <$> apostrophe)
(guardEnabled Ext_smart *> (return <$> apostrophe)
<* notFollowedBy (space <|> satisfy isPunctuation))
-- Parses material enclosed in *s, **s, _s, or __s.
@ -1697,7 +1697,7 @@ str = do
result <- many1 alphaNum
updateLastStrPos
let spacesToNbr = map (\c -> if c == ' ' then '\160' else c)
isSmart <- getOption readerSmart
isSmart <- extensionEnabled Ext_smart <$> getOption readerExtensions
if isSmart
then case likelyAbbrev result of
[] -> return $ return $ B.str result
@ -2104,7 +2104,7 @@ citation = try $ do
smart :: PandocMonad m => MarkdownParser m (F Inlines)
smart = do
getOption readerSmart >>= guard
guardEnabled Ext_smart
doubleQuoted <|> singleQuoted <|>
choice (map (return <$>) [apostrophe, dash, ellipses])

View file

@ -841,7 +841,7 @@ exportSnippet = try $ do
smart :: PandocMonad m => OrgParser m (F Inlines)
smart = do
getOption readerSmart >>= guard
guardEnabled Ext_smart
doubleQuoted <|> singleQuoted <|>
choice (map (return <$>) [orgApostrophe, orgDash, orgEllipses])
where

View file

@ -1309,7 +1309,7 @@ note = try $ do
smart :: PandocMonad m => RSTParser m Inlines
smart = do
getOption readerSmart >>= guard
guardEnabled Ext_smart
doubleQuoted <|> singleQuoted <|>
choice [apostrophe, dash, ellipses]

View file

@ -476,7 +476,7 @@ symbol = count 1 nonspaceChar >>= return . B.str
smart :: TWParser B.Inlines
smart = do
getOption readerSmart >>= guard
guardEnabled Ext_smart
doubleQuoted <|> singleQuoted <|>
choice [ apostrophe
, dash

View file

@ -47,13 +47,13 @@ tests = [ testGroup "markdown"
[ testGroup "writer"
$ writerTests "markdown" ++ lhsWriterTests "markdown"
, testGroup "reader"
[ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"]
[ test "basic" ["-r", "markdown+smart", "-w", "native", "-s"]
"testsuite.txt" "testsuite.native"
, test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
"tables.txt" "tables.native"
, test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
"pipe-tables.txt" "pipe-tables.native"
, test "more" ["-r", "markdown", "-w", "native", "-s", "-S"]
, test "more" ["-r", "markdown+smart", "-w", "native", "-s"]
"markdown-reader-more.txt" "markdown-reader-more.native"
, lhsReaderTest "markdown+lhs"
]
@ -65,8 +65,8 @@ tests = [ testGroup "markdown"
, testGroup "rst"
[ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
, testGroup "reader"
[ test "basic" ["-r", "rst", "-w", "native",
"-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native"
[ test "basic" ["-r", "rst+smart", "-w", "native",
"-s", "--columns=80"] "rst-reader.rst" "rst-reader.native"
, test "tables" ["-r", "rst", "-w", "native", "--columns=80"]
"tables.rst" "tables-rstsubset.native"
, lhsReaderTest "rst+lhs"

View file

@ -12,7 +12,8 @@ markdown :: String -> Pandoc
markdown = purely $ readMarkdown def
markdownSmart :: String -> Pandoc
markdownSmart = purely $ readMarkdown def { readerSmart = True }
markdownSmart = purely $ readMarkdown def { readerExtensions =
enableExtension Ext_smart $ readerExtensions def }
markdownCDL :: String -> Pandoc
markdownCDL = purely $ readMarkdown def { readerExtensions = enableExtension

View file

@ -12,7 +12,8 @@ org :: String -> Pandoc
org = purely $ readOrg def
orgSmart :: String -> Pandoc
orgSmart = purely $ readOrg def { readerSmart = True }
orgSmart = purely $ readOrg def { readerExtensions =
enableExtension Ext_smart $ readerExtensions def }
infix 4 =:
(=:) :: ToString c