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:
parent
3876b91448
commit
6f8b967d98
15 changed files with 55 additions and 69 deletions
45
MANUAL.txt
45
MANUAL.txt
|
@ -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
|
||||
|
|
29
pandoc.hs
29
pandoc.hs
|
@ -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"]
|
||||
|
|
|
@ -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]
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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])
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue