aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Writers/Groff.hs149
-rw-r--r--src/Text/Pandoc/Writers/Man.hs58
-rw-r--r--src/Text/Pandoc/Writers/Ms.hs88
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs11
-rw-r--r--test/command/3568.md2
-rw-r--r--test/command/4550.md2
-rw-r--r--test/tables.man8
-rw-r--r--test/tables.ms8
-rw-r--r--test/writer.man75
-rw-r--r--test/writer.ms34
11 files changed, 221 insertions, 215 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index b6560396c..2c19d73e7 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -532,6 +532,7 @@ library
Text.Pandoc.Readers.Org.ParserState,
Text.Pandoc.Readers.Org.Parsing,
Text.Pandoc.Readers.Org.Shared,
+ Text.Pandoc.Writers.Groff,
Text.Pandoc.Writers.Powerpoint.Presentation,
Text.Pandoc.Writers.Powerpoint.Output,
Text.Pandoc.Lua.Filter,
diff --git a/src/Text/Pandoc/Writers/Groff.hs b/src/Text/Pandoc/Writers/Groff.hs
new file mode 100644
index 000000000..aac76060e
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Groff.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-
+Copyright (C) 2007-2018 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : Text.Pandoc.Writers.Groff
+ Copyright : Copyright (C) 2007-2018 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Common functions for groff writers (man, ms).
+-}
+
+module Text.Pandoc.Writers.Groff (
+ WriterState(..)
+ , defaultWriterState
+ , MS
+ , Note
+ , escapeChar
+ , escapeString
+ , escapeCode
+ , groffEscape
+ , withFontFeature
+ ) where
+import Prelude
+import qualified Data.Text as T
+import Data.Char (isAscii, ord)
+import Control.Monad.State.Strict
+import Data.List (intercalate)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Definition
+import Text.Pandoc.Pretty
+import Text.Printf (printf)
+
+data WriterState = WriterState { stHasInlineMath :: Bool
+ , stFirstPara :: Bool
+ , stNotes :: [Note]
+ , stSmallCaps :: Bool
+ , stHighlighting :: Bool
+ , stInHeader :: Bool
+ , stFontFeatures :: Map.Map Char Bool
+ , stHasTables :: Bool
+ }
+
+defaultWriterState :: WriterState
+defaultWriterState = WriterState{ stHasInlineMath = False
+ , stFirstPara = True
+ , stNotes = []
+ , stSmallCaps = False
+ , stHighlighting = False
+ , stInHeader = False
+ , stFontFeatures = Map.fromList [
+ ('I',False)
+ , ('B',False)
+ , ('C',False)
+ ]
+ , stHasTables = False
+ }
+
+type Note = [Block]
+
+type MS = StateT WriterState
+
+-- | Association list of characters to escape.
+groffEscapes :: Map.Map Char String
+groffEscapes = Map.fromList
+ [ ('\160', "\\~")
+ , ('\'', "\\[aq]")
+ , ('`', "\\`")
+ , ('"', "\\[dq]")
+ , ('\x201C', "\\[lq]")
+ , ('\x201D', "\\[rq]")
+ , ('\x2018', "\\[oq]")
+ , ('\x2019', "\\[cq]")
+ , ('\x2014', "\\[em]")
+ , ('\x2013', "\\[en]")
+ , ('\x2026', "\\&...")
+ , ('~', "\\[ti]")
+ , ('^', "\\[ha]")
+ , ('@', "\\@")
+ , ('\\', "\\\\")
+ ]
+
+escapeChar :: Char -> String
+escapeChar c = fromMaybe [c] (Map.lookup c groffEscapes)
+
+-- | Escape special characters for groff.
+escapeString :: String -> String
+escapeString = concatMap escapeChar
+
+-- | Escape a literal (code) section for groff.
+escapeCode :: String -> String
+escapeCode = intercalate "\n" . map escapeLine . lines
+ where escapeCodeChar ' ' = "\\ "
+ escapeCodeChar '\t' = "\\\t"
+ escapeCodeChar c = escapeChar c
+ escapeLine codeline =
+ case concatMap escapeCodeChar codeline of
+ a@('.':_) -> "\\&" ++ a
+ b -> b
+
+-- | Escape non-ASCII characters using groff \u[..] sequences.
+groffEscape :: T.Text -> T.Text
+groffEscape = T.concatMap toUchar
+ where toUchar c
+ | isAscii c = T.singleton c
+ | otherwise = T.pack $ printf "\\[u%04X]" (ord c)
+
+fontChange :: PandocMonad m => MS m Doc
+fontChange = do
+ features <- gets stFontFeatures
+ inHeader <- gets stInHeader
+ let filling = ['C' | fromMaybe False $ Map.lookup 'C' features] ++
+ ['B' | inHeader ||
+ fromMaybe False (Map.lookup 'B' features)] ++
+ ['I' | fromMaybe False $ Map.lookup 'I' features]
+ return $
+ if null filling
+ then text "\\f[R]"
+ else text $ "\\f[" ++ filling ++ "]"
+
+withFontFeature :: PandocMonad m => Char -> MS m Doc -> MS m Doc
+withFontFeature c action = do
+ modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
+ begin <- fontChange
+ d <- action
+ modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
+ end <- fontChange
+ return $ begin <> d <> end
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 247666b33..65aec81b3 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -33,8 +33,7 @@ Conversion of 'Pandoc' documents to groff man page format.
module Text.Pandoc.Writers.Man ( writeMan) where
import Prelude
import Control.Monad.State.Strict
-import Data.List (intercalate, intersperse, sort, stripPrefix)
-import qualified Data.Map as Map
+import Data.List (intersperse, stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -48,22 +47,9 @@ import Text.Pandoc.Shared
import Text.Pandoc.Templates
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
+import Text.Pandoc.Writers.Groff
import Text.Printf (printf)
-type Notes = [[Block]]
-data WriterState = WriterState { stNotes :: Notes
- , stFontFeatures :: Map.Map Char Bool
- , stHasTables :: Bool }
-
-defaultWriterState :: WriterState
-defaultWriterState = WriterState { stNotes = []
- , stFontFeatures = Map.fromList [
- ('I',False)
- , ('B',False)
- , ('C',False)
- ]
- , stHasTables = False }
-
-- | Convert Pandoc to Man.
writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMan opts document =
@@ -127,28 +113,6 @@ noteToMan opts num note = do
let marker = cr <> text ".SS " <> brackets (text (show num))
return $ marker $$ contents
--- | Association list of characters to escape.
-manEscapes :: [(Char, String)]
-manEscapes = [ ('\160', "\\ ")
- , ('\'', "\\[aq]")
- , ('’', "'")
- , ('\x2014', "\\[em]")
- , ('\x2013', "\\[en]")
- , ('\x2026', "\\&...")
- ] ++ backslashEscapes "-@\\"
-
--- | Escape special characters for Man.
-escapeString :: String -> String
-escapeString = escapeStringUsing manEscapes
-
--- | Escape a literal (code) section for Man.
-escapeCode :: String -> String
-escapeCode = intercalate "\n" . map escapeLine . lines where
- escapeLine codeline =
- case escapeStringUsing (manEscapes ++ backslashEscapes "\t ") codeline of
- a@('.':_) -> "\\&" ++ a
- b -> b
-
-- We split inline lists into sentences, and print one sentence per
-- line. groff/troff treats the line-ending period differently.
-- See http://code.google.com/p/pandoc/issues/detail?id=148.
@@ -373,21 +337,3 @@ inlineToMan _ (Note contents) = do
notes <- gets stNotes
let ref = show (length notes)
return $ char '[' <> text ref <> char ']'
-
-fontChange :: PandocMonad m => StateT WriterState m Doc
-fontChange = do
- features <- gets stFontFeatures
- let filling = sort [c | (c,True) <- Map.toList features]
- return $ text $ "\\f[" ++ (if null filling then "R" else filling) ++ "]"
-
-withFontFeature :: PandocMonad m
- => Char
- -> StateT WriterState m Doc
- -> StateT WriterState m Doc
-withFontFeature c action = do
- modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
- begin <- fontChange
- d <- action
- modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
- end <- fontChange
- return $ begin <> d <> end
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index 9a35a9693..cdca24702 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -60,36 +60,10 @@ import Text.Pandoc.Shared
import Text.Pandoc.Templates
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
+import Text.Pandoc.Writers.Groff
import Text.Printf (printf)
import Text.TeXMath (writeEqn)
-data WriterState = WriterState { stHasInlineMath :: Bool
- , stFirstPara :: Bool
- , stNotes :: [Note]
- , stSmallCaps :: Bool
- , stHighlighting :: Bool
- , stInHeader :: Bool
- , stFontFeatures :: Map.Map Char Bool
- }
-
-defaultWriterState :: WriterState
-defaultWriterState = WriterState{ stHasInlineMath = False
- , stFirstPara = True
- , stNotes = []
- , stSmallCaps = False
- , stHighlighting = False
- , stInHeader = False
- , stFontFeatures = Map.fromList [
- ('I',False)
- , ('B',False)
- , ('C',False)
- ]
- }
-
-type Note = [Block]
-
-type MS = StateT WriterState
-
-- | Convert Pandoc to Ms.
writeMs :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMs opts document =
@@ -132,24 +106,8 @@ pandocToMs opts (Pandoc meta blocks) = do
Nothing -> return main
Just tpl -> renderTemplate' tpl context
--- | Association list of characters to escape.
-msEscapes :: Map.Map Char String
-msEscapes = Map.fromList
- [ ('\160', "\\~")
- , ('\'', "\\[aq]")
- , ('`', "\\`")
- , ('"', "\\[dq]")
- , ('\x2014', "\\[em]")
- , ('\x2013', "\\[en]")
- , ('\x2026', "\\&...")
- , ('~', "\\[ti]")
- , ('^', "\\[ha]")
- , ('@', "\\@")
- , ('\\', "\\\\")
- ]
-
-escapeChar :: Char -> String
-escapeChar c = fromMaybe [c] (Map.lookup c msEscapes)
+escapeUri :: String -> String
+escapeUri = escapeURIString (\c -> c /= '@' && isAllowedInURI c)
-- | Escape | character, used to mark inline math, inside math.
escapeBar :: String -> String
@@ -157,13 +115,6 @@ escapeBar = concatMap go
where go '|' = "\\[u007C]"
go c = [c]
--- | Escape special characters for Ms.
-escapeString :: String -> String
-escapeString = concatMap escapeChar
-
-escapeUri :: String -> String
-escapeUri = escapeURIString (\c -> c /= '@' && isAllowedInURI c)
-
toSmallCaps :: String -> String
toSmallCaps [] = []
toSmallCaps (c:cs)
@@ -174,17 +125,6 @@ toSmallCaps (c:cs)
in escapeString uppers ++ toSmallCaps rest
| otherwise = escapeChar c ++ toSmallCaps cs
--- | Escape a literal (code) section for Ms.
-escapeCode :: String -> String
-escapeCode = intercalate "\n" . map escapeLine . lines
- where escapeCodeChar ' ' = "\\ "
- escapeCodeChar '\t' = "\\\t"
- escapeCodeChar c = escapeChar c
- escapeLine codeline =
- case concatMap escapeCodeChar codeline of
- a@('.':_) -> "\\&" ++ a
- b -> b
-
-- We split inline lists into sentences, and print one sentence per
-- line. groff/troff treats the line-ending period differently.
-- See http://code.google.com/p/pandoc/issues/detail?id=148.
@@ -535,28 +475,6 @@ handleNote opts bs = do
contents <- blockListToMs opts bs'
return $ cr <> text ".FS" $$ contents $$ text ".FE" <> cr
-fontChange :: PandocMonad m => MS m Doc
-fontChange = do
- features <- gets stFontFeatures
- inHeader <- gets stInHeader
- let filling = ['C' | fromMaybe False $ Map.lookup 'C' features] ++
- ['B' | inHeader ||
- fromMaybe False (Map.lookup 'B' features)] ++
- ['I' | fromMaybe False $ Map.lookup 'I' features]
- return $
- if null filling
- then text "\\f[R]"
- else text $ "\\f[" ++ filling ++ "]"
-
-withFontFeature :: PandocMonad m => Char -> MS m Doc -> MS m Doc
-withFontFeature c action = do
- modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
- begin <- fontChange
- d <- action
- modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
- end <- fontChange
- return $ begin <> d <> end
-
setFirstPara :: PandocMonad m => MS m ()
setFirstPara = modify $ \st -> st{ stFirstPara = True }
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index a7bf30aaa..09e45df90 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -47,7 +47,6 @@ module Text.Pandoc.Writers.Shared (
, lookupMetaInlines
, lookupMetaString
, stripLeadingTrailingSpace
- , groffEscape
, toSubscript
, toSuperscript
)
@@ -56,7 +55,7 @@ import Prelude
import Control.Monad (zipWithM)
import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
encode, fromJSON)
-import Data.Char (chr, ord, isAscii, isSpace)
+import Data.Char (chr, ord, isSpace)
import qualified Data.HashMap.Strict as H
import Data.List (groupBy, intersperse, transpose)
import qualified Data.Map as M
@@ -70,7 +69,6 @@ import Text.Pandoc.Pretty
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.UTF8 (toStringLazy)
import Text.Pandoc.XML (escapeStringForXML)
-import Text.Printf (printf)
-- | Create JSON value for template from a 'Meta' and an association list
-- of variables, specified at the command line or in the writer.
@@ -387,13 +385,6 @@ lookupMetaString key meta =
Just (MetaBool b) -> show b
_ -> ""
--- | Escape non-ASCII characters using groff \u[..] sequences.
-groffEscape :: T.Text -> T.Text
-groffEscape = T.concatMap toUchar
- where toUchar c
- | isAscii c = T.singleton c
- | otherwise = T.pack $ printf "\\[u%04X]" (ord c)
-
toSuperscript :: Char -> Maybe Char
toSuperscript '1' = Just '\x00B9'
diff --git a/test/command/3568.md b/test/command/3568.md
index 919972ed3..f88c2fe9a 100644
--- a/test/command/3568.md
+++ b/test/command/3568.md
@@ -10,7 +10,7 @@ normal `code` normal.
normal \f[I]italic \f[BI]bold in the middle\f[I] only italic\f[R]
normal.
.PP
-normal \f[B]bold \f[BC]code\f[B] more bold\f[R] normal.
+normal \f[B]bold \f[CB]code\f[B] more bold\f[R] normal.
.PP
normal \f[C]code\f[R] normal.
```
diff --git a/test/command/4550.md b/test/command/4550.md
index bf3afce5b..45ed21a00 100644
--- a/test/command/4550.md
+++ b/test/command/4550.md
@@ -3,5 +3,5 @@
A ‘simple’ example
^D
.LP
-A ‘simple’ example
+A \[oq]simple\[cq] example
```
diff --git a/test/tables.man b/test/tables.man
index 8c9385b4f..7d4d4cd03 100644
--- a/test/tables.man
+++ b/test/tables.man
@@ -135,7 +135,7 @@ T}
.PP
Multiline table with caption:
.PP
-Here's the caption. It may span multiple lines.
+Here\[cq]s the caption. It may span multiple lines.
.TS
tab(@);
cw(10.5n) lw(9.6n) rw(11.4n) lw(24.5n).
@@ -165,7 +165,7 @@ row
T}@T{
5.0
T}@T{
-Here's another one.
+Here\[cq]s another one.
Note the blank line between rows.
T}
.TE
@@ -201,7 +201,7 @@ row
T}@T{
5.0
T}@T{
-Here's another one.
+Here\[cq]s another one.
Note the blank line between rows.
T}
.TE
@@ -261,7 +261,7 @@ row
T}@T{
5.0
T}@T{
-Here's another one.
+Here\[cq]s another one.
Note the blank line between rows.
T}
.TE
diff --git a/test/tables.ms b/test/tables.ms
index 6d9138c64..90662aaad 100644
--- a/test/tables.ms
+++ b/test/tables.ms
@@ -135,7 +135,7 @@ T}
.LP
Multiline table with caption:
.PP
-Here’s the caption. It may span multiple lines.
+Here\[cq]s the caption. It may span multiple lines.
.TS
delim(@@) tab( );
cw(10.5n) lw(9.6n) rw(11.4n) lw(24.5n).
@@ -165,7 +165,7 @@ row
T} T{
5.0
T} T{
-Here’s another one.
+Here\[cq]s another one.
Note the blank line between rows.
T}
.TE
@@ -201,7 +201,7 @@ row
T} T{
5.0
T} T{
-Here’s another one.
+Here\[cq]s another one.
Note the blank line between rows.
T}
.TE
@@ -261,7 +261,7 @@ row
T} T{
5.0
T} T{
-Here’s another one.
+Here\[cq]s another one.
Note the blank line between rows.
T}
.TE
diff --git a/test/writer.man b/test/writer.man
index 3cb0276fa..12b51c071 100644
--- a/test/writer.man
+++ b/test/writer.man
@@ -2,7 +2,7 @@
.hy
.PP
This is a set of tests for pandoc.
-Most of them are adapted from John Gruber's markdown test suite.
+Most of them are adapted from John Gruber\[cq]s markdown test suite.
.PP
* * * * *
.SH Headers
@@ -22,15 +22,15 @@ with no blank line
* * * * *
.SH Paragraphs
.PP
-Here's a regular paragraph.
+Here\[cq]s a regular paragraph.
.PP
In Markdown 1.0.0 and earlier.
Version 8.
This line turns into a list item.
-Because a hard\-wrapped line in the middle of a paragraph looked like a list
+Because a hard-wrapped line in the middle of a paragraph looked like a list
item.
.PP
-Here's one with a bullet.
+Here\[cq]s one with a bullet.
* criminey.
.PP
There should be a hard line break
@@ -42,7 +42,7 @@ here.
* * * * *
.SH Block Quotes
.PP
-E\-mail style:
+E-mail style:
.RS
.PP
This is a block quote.
@@ -55,7 +55,7 @@ Code in a block quote:
.nf
\f[C]
sub\ status\ {
-\ \ \ \ print\ "working";
+\ \ \ \ print\ \[dq]working\[dq];
}
\f[R]
.fi
@@ -88,10 +88,10 @@ Code:
.IP
.nf
\f[C]
-\-\-\-\-\ (should\ be\ four\ hyphens)
+----\ (should\ be\ four\ hyphens)
sub\ status\ {
-\ \ \ \ print\ "working";
+\ \ \ \ print\ \[dq]working\[dq];
}
this\ code\ block\ is\ indented\ by\ one\ tab
@@ -200,7 +200,7 @@ Item 1, graf one.
.PP
Item 1.
graf two.
-The quick brown fox jumped over the lazy dog's back.
+The quick brown fox jumped over the lazy dog\[cq]s back.
.RE
.IP "2." 3
Item 2.
@@ -218,7 +218,7 @@ Tab
.RE
.RE
.PP
-Here's another:
+Here\[cq]s another:
.IP "1." 3
First
.IP "2." 3
@@ -308,7 +308,7 @@ Nested.
.PP
Should not be a list item:
.PP
-M.A.\ 2007
+M.A.\~2007
.PP
B.
Williams
@@ -459,7 +459,7 @@ Interpreted markdown in a table:
This is \f[I]emphasized\f[R]
And this is \f[B]strong\f[R]
.PP
-Here's a simple block:
+Here\[cq]s a simple block:
.PP
foo
.PP
@@ -492,7 +492,7 @@ Code block:
.IP
.nf
\f[C]
-<!\-\-\ Comment\ \-\->
+<!--\ Comment\ -->
\f[R]
.fi
.PP
@@ -506,7 +506,7 @@ Code:
\f[R]
.fi
.PP
-Hr's:
+Hr\[cq]s:
.PP
* * * * *
.SH Inline Markup
@@ -530,12 +530,12 @@ This is code: \f[C]>\f[R], \f[C]$\f[R], \f[C]\\\f[R], \f[C]\\$\f[R],
.PP
[STRIKEOUT:This is \f[I]strikeout\f[R].]
.PP
-Superscripts: a^bc^d a^\f[I]hello\f[R]^ a^hello\ there^.
+Superscripts: a^bc^d a^\f[I]hello\f[R]^ a^hello\~there^.
.PP
-Subscripts: H~2~O, H~23~O, H~many\ of\ them~O.
+Subscripts: H~2~O, H~23~O, H~many\~of\~them~O.
.PP
These should not be superscripts or subscripts, because of the unescaped
-spaces: a^b c^d, a~b c~d.
+spaces: a\[ha]b c\[ha]d, a\[ti]b c\[ti]d.
.PP
* * * * *
.SH Smart quotes, ellipses, dashes
@@ -548,7 +548,7 @@ spaces: a^b c^d, a~b c~d.
`Oak,' `elm,' and `beech' are names of trees.
So is `pine.'
.PP
-`He said, \[lq]I want to go.\[rq]' Were you alive in the 70's?
+`He said, \[lq]I want to go.\[rq]' Were you alive in the 70\[cq]s?
.PP
Here is some quoted `\f[C]code\f[R]' and a \[lq]quoted
link (http://example.com/?foo=1&bar=2)\[rq].
@@ -571,19 +571,19 @@ Ellipses\&...and\&...and\&....
.IP \[bu] 2
223
.IP \[bu] 2
-\f[I]p\f[R]\-Tree
+\f[I]p\f[R]-Tree
.IP \[bu] 2
-Here's some display math:
+Here\[cq]s some display math:
.RS
-$$\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)\-f(x)}{h}$$
+$$\\frac{d}{dx}f(x)=\\lim_{h\\to 0}\\frac{f(x+h)-f(x)}{h}$$
.RE
.IP \[bu] 2
-Here's one that has a line break in it:
+Here\[cq]s one that has a line break in it:
\f[I]α\f[R] + \f[I]ω\f[R] × \f[I]x\f[R]^2^.
.PP
-These shouldn't be math:
+These shouldn\[cq]t be math:
.IP \[bu] 2
-To get the famous equation, write \f[C]$e\ =\ mc^2$\f[R].
+To get the famous equation, write \f[C]$e\ =\ mc\[ha]2$\f[R].
.IP \[bu] 2
$22,000 is a \f[I]lot\f[R] of money.
So is $34,000.
@@ -593,7 +593,7 @@ Shoes ($20) and socks ($5).
.IP \[bu] 2
Escaped \f[C]$\f[R]: $73 \f[I]this should be emphasized\f[R] 23$.
.PP
-Here's a LaTeX table:
+Here\[cq]s a LaTeX table:
.PP
* * * * *
.SH Special Characters
@@ -622,7 +622,7 @@ This & that.
.PP
Backslash: \\
.PP
-Backtick: `
+Backtick: \`
.PP
Asterisk: *
.PP
@@ -640,7 +640,7 @@ Left paren: (
.PP
Right paren: )
.PP
-Greater\-than: >
+Greater-than: >
.PP
Hash: #
.PP
@@ -650,7 +650,7 @@ Bang: !
.PP
Plus: +
.PP
-Minus: \-
+Minus: -
.PP
* * * * *
.SH Links
@@ -700,13 +700,14 @@ Foo bar (/url/).
Foo biz (/url/).
.SS With ampersands
.PP
-Here's a link with an ampersand in the URL (http://example.com/?foo=1&bar=2).
+Here\[cq]s a link with an ampersand in the
+URL (http://example.com/?foo=1&bar=2).
.PP
-Here's a link with an amersand in the link text: AT&T (http://att.com/).
+Here\[cq]s a link with an amersand in the link text: AT&T (http://att.com/).
.PP
-Here's an inline link (/script?foo=1&bar=2).
+Here\[cq]s an inline link (/script?foo=1&bar=2).
.PP
-Here's an inline link in pointy braces (/script?foo=1&bar=2).
+Here\[cq]s an inline link in pointy braces (/script?foo=1&bar=2).
.SS Autolinks
.PP
With an ampersand: <http://example.com/?foo=1&bar=2>
@@ -717,13 +718,13 @@ In a list?
.IP \[bu] 2
It should.
.PP
-An e\-mail address: <nobody@nowhere.net>
+An e-mail address: <nobody@nowhere.net>
.RS
.PP
Blockquoted: <http://example.com/>
.RE
.PP
-Auto\-links should not occur here: \f[C]<http://example.com/>\f[R]
+Auto-links should not occur here: \f[C]<http://example.com/>\f[R]
.IP
.nf
\f[C]
@@ -744,8 +745,8 @@ Here is a movie [IMAGE: movie (movie.jpg)] icon.
.SH Footnotes
.PP
Here is a footnote reference,[1] and another.[2] This should \f[I]not\f[R] be
-a footnote reference, because it contains a space.[^my note] Here is an inline
-note.[3]
+a footnote reference, because it contains a space.[\[ha]my note] Here is an
+inline note.[3]
.RS
.PP
Notes can go in quotes.[4]
@@ -762,7 +763,7 @@ It can go anywhere after the footnote reference.
It need not be placed at the end of the document.
.SS [2]
.PP
-Here's the long note.
+Here\[cq]s the long note.
This one contains multiple blocks.
.PP
Subsequent blocks are indented to show that they belong to the footnote (as
diff --git a/test/writer.ms b/test/writer.ms
index e7ac44bb9..8480f5520 100644
--- a/test/writer.ms
+++ b/test/writer.ms
@@ -75,7 +75,7 @@ July 17, 2006
.1C
.LP
This is a set of tests for pandoc.
-Most of them are adapted from John Gruber’s markdown test suite.
+Most of them are adapted from John Gruber\[cq]s markdown test suite.
.HLINE
.SH 1
Headers
@@ -126,7 +126,7 @@ Paragraphs
.pdfhref O 1 "Paragraphs"
.pdfhref M "paragraphs"
.LP
-Here’s a regular paragraph.
+Here\[cq]s a regular paragraph.
.PP
In Markdown 1.0.0 and earlier.
Version 8.
@@ -134,7 +134,7 @@ This line turns into a list item.
Because a hard-wrapped line in the middle of a paragraph looked like a list
item.
.PP
-Here’s one with a bullet.
+Here\[cq]s one with a bullet.
* criminey.
.PP
There should be a hard line break
@@ -314,7 +314,7 @@ Item 1, graf one.
.PP
Item 1.
graf two.
-The quick brown fox jumped over the lazy dog’s back.
+The quick brown fox jumped over the lazy dog\[cq]s back.
.RE
.IP " 2." 4
Item 2.
@@ -335,7 +335,7 @@ Tab
.RE
.RE
.LP
-Here’s another:
+Here\[cq]s another:
.IP " 1." 4
First
.IP " 2." 4
@@ -570,7 +570,7 @@ Interpreted markdown in a table:
This is \f[I]emphasized\f[R]
And this is \f[B]strong\f[R]
.PP
-Here’s a simple block:
+Here\[cq]s a simple block:
.LP
foo
.LP
@@ -617,7 +617,7 @@ Code:
\f[]
.fi
.LP
-Hr’s:
+Hr\[cq]s:
.HLINE
.SH 1
Inline Markup
@@ -666,7 +666,7 @@ Smart quotes, ellipses, dashes
`Oak,' `elm,' and `beech' are names of trees.
So is `pine.'
.PP
-`He said, \[lq]I want to go.\[rq]' Were you alive in the 70’s?
+`He said, \[lq]I want to go.\[rq]' Were you alive in the 70\[cq]s?
.PP
Here is some quoted `\f[C]code\f[R]' and a \[lq]\c
.pdfhref W -D "http://example.com/?foo=1&bar=2" -A "\c" \
@@ -695,14 +695,14 @@ LaTeX
.IP \[bu] 3
@p@-Tree
.IP \[bu] 3
-Here’s some display math:
+Here\[cq]s some display math:
.EQ
d over {d x} f ( x ) = lim sub {h -> 0} {f ( x + h ) \[u2212] f ( x )} over h
.EN
.IP \[bu] 3
-Here’s one that has a line break in it: @alpha + omega times x sup 2@.
+Here\[cq]s one that has a line break in it: @alpha + omega times x sup 2@.
.LP
-These shouldn’t be math:
+These shouldn\[cq]t be math:
.IP \[bu] 3
To get the famous equation, write \f[C]$e\ =\ mc\[ha]2$\f[R].
.IP \[bu] 3
@@ -714,7 +714,7 @@ Shoes ($20) and socks ($5).
.IP \[bu] 3
Escaped \f[C]$\f[R]: $73 \f[I]this should be emphasized\f[R] 23$.
.LP
-Here’s a LaTeX table:
+Here\[cq]s a LaTeX table:
.HLINE
.SH 1
Special Characters
@@ -885,22 +885,22 @@ With ampersands
.pdfhref O 2 "With ampersands"
.pdfhref M "with-ampersands"
.LP
-Here’s a \c
+Here\[cq]s a \c
.pdfhref W -D "http://example.com/?foo=1&bar=2" -A "\c" \
-- "link with an ampersand in the URL"
\&.
.PP
-Here’s a link with an amersand in the link text: \c
+Here\[cq]s a link with an amersand in the link text: \c
.pdfhref W -D "http://att.com/" -A "\c" \
-- "AT&T"
\&.
.PP
-Here’s an \c
+Here\[cq]s an \c
.pdfhref W -D "/script?foo=1&bar=2" -A "\c" \
-- "inline link"
\&.
.PP
-Here’s an \c
+Here\[cq]s an \c
.pdfhref W -D "/script?foo=1&bar=2" -A "\c" \
-- "inline link in pointy braces"
\&.
@@ -967,7 +967,7 @@ It need not be placed at the end of the document.
.FE
and another.\**
.FS
-Here’s the long note.
+Here\[cq]s the long note.
This one contains multiple blocks.
.PP
Subsequent blocks are indented to show that they belong to the footnote (as