6 files changed, 604 insertions, 194 deletions
diff --git a/src/Text/Pandoc/GroffChar.hs b/src/Text/Pandoc/GroffChar.hs
new file mode 100644
index 000000000..8664c627f
--- /dev/null
+++ b/src/Text/Pandoc/GroffChar.hs
@@ -0,0 +1,419 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-
+Copyright (C) 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.GroffChar
+   Copyright   : Copyright (C) 2007-2018 John MacFarlane
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : John MacFarlane <jgm@berkeley.edu>
+   Stability   : alpha
+   Portability : portable
+
+Groff character escaping/unescaping.
+-}
+
+module Text.Pandoc.GroffChar (
+    essentialEscapes
+  , characterCodes
+  , combiningAccents
+  ) where
+import Prelude
+import qualified Data.Map as Map
+
+essentialEscapes :: Map.Map Char String
+essentialEscapes = Map.fromList
+  [ ('\160', "\\~")
+  , ('\'', "\\[aq]")
+  , ('`', "\\[ga]")
+  , ('"', "\\[dq]")
+  , ('~', "\\[ti]")
+  , ('^', "\\[ha]")
+  , ('@', "\\[at]")
+  , ('\\', "\\[rs]")
+  , ('\x2026', "\\&...")  -- because u2026 doesn't render on tty
+  , ('\x2212', "\\-")  -- minus
+  ]
+
+characterCodes :: [(Char, String)]
+characterCodes =
+  [ ('Ð', "-D")
+  , ('ð', "Sd")
+  , ('Þ', "TP")
+  , ('þ', "Tp")
+  , ('ß', "ss")
+  , ('ﬀ', "ff")
+  , ('ﬁ', "fi")
+  , ('ﬂ', "fl")
+  , ('ﬃ', "Fi")
+  , ('ﬄ', "Fl")
+  , ('Ł', "/L")
+  , ('ł', "/l")
+  , ('Ø', "/O")
+  , ('ø', "/o")
+  , ('Æ', "AE")
+  , ('æ', "ae")
+  , ('Œ', "OE")
+  , ('œ', "oe")
+  , ('Ĳ', "IJ")
+  , ('ĳ', "ij")
+  , ('ı', ".i")
+  , ('ȷ', ".j")
+  , ('Á', "'A")
+  , ('Ć', "'C")
+  , ('É', "'E")
+  , ('Í', "'I")
+  , ('Ó', "'O")
+  , ('Ú', "'U")
+  , ('Ý', "'Y")
+  , ('á', "'a")
+  , ('ć', "'c")
+  , ('é', "'e")
+  , ('í', "'i")
+  , ('ó', "'o")
+  , ('ú', "'u")
+  , ('ý', "'y")
+  , ('Ä', ":A")
+  , ('Ë', ":E")
+  , ('Ï', ":I")
+  , ('Ö', ":O")
+  , ('Ü', ":U")
+  , ('Ÿ', ":Y")
+  , ('ä', ":a")
+  , ('ë', ":e")
+  , ('ï', ":i")
+  , ('ö', ":o")
+  , ('ü', ":u")
+  , ('ÿ', ":y")
+  , ('Â', "^A")
+  , ('Ê', "^E")
+  , ('Î', "^I")
+  , ('Ô', "^O")
+  , ('Û', "^U")
+  , ('â', "^a")
+  , ('ê', "^e")
+  , ('î', "^i")
+  , ('ô', "^o")
+  , ('û', "^u")
+  , ('À', "`A")
+  , ('È', "`E")
+  , ('Ì', "`I")
+  , ('Ò', "`O")
+  , ('Ù', "`U")
+  , ('à', "`a")
+  , ('è', "`e")
+  , ('ì', "`i")
+  , ('ò', "`o")
+  , ('ù', "`u")
+  , ('Ã', "~A")
+  , ('Ñ', "~N")
+  , ('Õ', "~O")
+  , ('ã', "~a")
+  , ('ñ', "~n")
+  , ('õ', "~o")
+  , ('Š', "vS")
+  , ('š', "vs")
+  , ('Ž', "vZ")
+  , ('ž', "vz")
+  , ('Ç', ",C")
+  , ('ç', ",c")
+  , ('Å', "oA")
+  , ('å', "oa")
+  , ('˝', "a\"")
+  , ('¯', "a-")
+  , ('˙', "a.")
+  , ('^', "a^")
+  , ('´', "aa")
+  , ('`', "ga")
+  , ('˘', "ab")
+  , ('¸', "ac")
+  , ('¨', "ad")
+  , ('ˇ', "ah")
+  , ('˚', "ao")
+  , ('~', "a~")
+  , ('˛', "ho")
+  , ('^', "ha")
+  , ('~', "ti")
+  , ('„', "Bq")
+  , ('‚', "bq")
+  , ('“', "lq")
+  , ('”', "rq")
+  , ('‘', "oq")
+  , ('’', "cq")
+  , ('\'', "aq")
+  , ('"', "dq")
+  , ('«', "Fo")
+  , ('»', "Fc")
+  , ('‹', "fo")
+  , ('›', "fc")
+  , ('¡', "r!")
+  , ('¿', "r?")
+  , ('—', "em")
+  , ('–', "en")
+  , ('‐', "hy")
+  , ('[', "lB")
+  , (']', "rB")
+  , ('{', "lC")
+  , ('}', "rC")
+  , ('⟨', "la")
+  , ('⟩', "ra")
+  , ('⎪', "bv")
+  , ('⎪', "braceex")
+  , ('⎡', "bracketlefttp")
+  , ('⎣', "bracketleftbt")
+  , ('⎢', "bracketleftex")
+  , ('⎤', "bracketrighttp")
+  , ('⎦', "bracketrightbt")
+  , ('⎥', "bracketrightex")
+  , ('╭', "lt")
+  , ('⎧', "bracelefttp")
+  , ('┥', "lk")
+  , ('⎨', "braceleftmid")
+  , ('╰', "lb")
+  , ('⎩', "braceleftbt")
+  , ('⎪', "braceleftex")
+  , ('╮', "rt")
+  , ('⎫', "bracerighttp")
+  , ('┝', "rk")
+  , ('⎬', "bracerightmid")
+  , ('╯', "rb")
+  , ('⎭', "bracerightbt")
+  , ('⎪', "bracerightex")
+  , ('⎛', "parenlefttp")
+  , ('⎝', "parenleftbt")
+  , ('⎜', "parenleftex")
+  , ('⎞', "parenrighttp")
+  , ('⎠', "parenrightbt")
+  , ('⎟', "parenrightex")
+  , ('←', "<-")
+  , ('→', "->")
+  , ('↔', "<>")
+  , ('↓', "da")
+  , ('↑', "ua")
+  , ('↕', "va")
+  , ('⇐', "lA")
+  , ('⇒', "rA")
+  , ('⇔', "hA")
+  , ('⇓', "dA")
+  , ('⇑', "uA")
+  , ('⇕', "vA")
+  , ('⎯', "an")
+  , ('|', "ba")
+  , ('│', "br")
+  , ('_', "ul")
+  , ('‾', "rn")
+  , ('_', "ru")
+  , ('¦', "bb")
+  , ('/', "sl")
+  , ('\\', "rs")
+  , ('○', "ci")
+  , ('·', "bu")
+  , ('‡', "dd")
+  , ('†', "dg")
+  , ('◊', "lz")
+  , ('□', "sq")
+  , ('¶', "ps")
+  , ('§', "sc")
+  , ('☜', "lh")
+  , ('☞', "rh")
+  , ('@', "at")
+  , ('#', "sh")
+  , ('↵', "CR")
+  , ('✓', "OK")
+  , ('©', "co")
+  , ('®', "rg")
+  , ('™', "tm")
+  , ('$', "Do")
+  , ('¢', "ct")
+  , ('€', "eu")
+  , ('€', "Eu")
+  , ('¥', "Ye")
+  , ('£', "Po")
+  , ('¤', "Cs")
+  , ('ƒ', "Fn")
+  , ('°', "de")
+  , ('‰', "%0")
+  , ('′', "fm")
+  , ('″', "sd")
+  , ('µ', "mc")
+  , ('ª', "Of")
+  , ('º', "Om")
+  , ('∧', "AN")
+  , ('∨', "OR")
+  , ('¬', "no")
+  , ('¬', "tno")
+  , ('∃', "te")
+  , ('∀', "fa")
+  , ('∋', "st")
+  , ('∴', "3d")
+  , ('∴', "tf")
+  , ('|', "or")
+  , ('½', "12")
+  , ('¼', "14")
+  , ('¾', "34")
+  , ('⅛', "18")
+  , ('⅜', "38")
+  , ('⅝', "58")
+  , ('⅞', "78")
+  , ('¹', "S1")
+  , ('²', "S2")
+  , ('³', "S3")
+  , ('+', "pl")
+  , ('−', "mi")
+  , ('∓', "-+")
+  , ('±', "+-")
+  , ('±', "t+-")
+  , ('·', "pc")
+  , ('⋅', "md")
+  , ('×', "mu")
+  , ('×', "tmu")
+  , ('⊗', "c*")
+  , ('⊕', "c+")
+  , ('÷', "di")
+  , ('÷', "tdi")
+  , ('⁄', "f/")
+  , ('∗', "**")
+  , ('≤', "<=")
+  , ('≥', ">=")
+  , ('≪', "<<")
+  , ('≫', ">>")
+  , ('=', "eq")
+  , ('≠', "!=")
+  , ('≡', "==")
+  , ('≢', "ne")
+  , ('≅', "=~")
+  , ('≃', "|=")
+  , ('∼', "ap")
+  , ('≈', "~~")
+  , ('≈', "~=")
+  , ('∝', "pt")
+  , ('∅', "es")
+  , ('∈', "mo")
+  , ('∉', "nm")
+  , ('⊂', "sb")
+  , ('⊄', "nb")
+  , ('⊃', "sp")
+  , ('⊅', "nc")
+  , ('⊆', "ib")
+  , ('⊇', "ip")
+  , ('∩', "ca")
+  , ('∪', "cu")
+  , ('∠', "/_")
+  , ('⊥', "pp")
+  , ('∫', "is")
+  , ('∫', "integral")
+  , ('∑', "sum")
+  , ('∏', "product")
+  , ('∐', "coproduct")
+  , ('∇', "gr")
+  , ('√', "sr")
+  , ('√', "sqrt")
+  -- , "radicalex"
+  -- "sqrtex"
+  , ('⌈', "lc")
+  , ('⌉', "rc")
+  , ('⌊', "lf")
+  , ('⌋', "rf")
+  , ('∞', "if")
+  , ('ℵ', "Ah")
+  , ('ℑ', "Im")
+  , ('ℜ', "Re")
+  , ('℘', "wp")
+  , ('∂', "pd")
+  , ('ℏ', "-h")
+  , ('ℏ', "hbar")
+  , ('Α', "*A")
+  , ('Β', "*B")
+  , ('Γ', "*G")
+  , ('Δ', "*D")
+  , ('Ε', "*E")
+  , ('Ζ', "*Z")
+  , ('Η', "*Y")
+  , ('Θ', "*H")
+  , ('Ι', "*I")
+  , ('Κ', "*K")
+  , ('Λ', "*L")
+  , ('Μ', "*M")
+  , ('Ν', "*N")
+  , ('Ξ', "*C")
+  , ('Ο', "*O")
+  , ('Π', "*P")
+  , ('Ρ', "*R")
+  , ('Σ', "*S")
+  , ('Τ', "*T")
+  , ('Υ', "*U")
+  , ('Φ', "*F")
+  , ('Χ', "*X")
+  , ('Ψ', "*Q")
+  , ('Ω', "*W")
+  , ('α', "*a")
+  , ('β', "*b")
+  , ('γ', "*g")
+  , ('δ', "*d")
+  , ('ε', "*e")
+  , ('ζ', "*z")
+  , ('η', "*y")
+  , ('θ', "*h")
+  , ('ι', "*i")
+  , ('κ', "*k")
+  , ('λ', "*l")
+  , ('μ', "*m")
+  , ('ν', "*n")
+  , ('ξ', "*c")
+  , ('ο', "*o")
+  , ('π', "*p")
+  , ('ρ', "*r")
+  , ('ς', "ts")
+  , ('σ', "*s")
+  , ('τ', "*t")
+  , ('υ', "*u")
+  , ('ϕ', "*f")
+  , ('χ', "*x")
+  , ('ψ', "*q")
+  , ('ω', "*w")
+  , ('ϑ', "+h")
+  , ('φ', "+f")
+  , ('ϖ', "+p")
+  , ('ϵ', "+e")
+  , ('♣', "CL")
+  , ('♠', "SP")
+  , ('♥', "HE")
+  , ('♦', "DI")
+  ]
+
+-- use like: \\[E a^ aa]
+combiningAccents :: [(Char, String)]
+combiningAccents =
+  [ ('˝' , "a\"")
+  , ('¯', "a-")
+  , ('˙', "a.")
+  , ('^', "a^")
+  , ('´', "aa")
+  , ('`', "ga")
+  , ('˘', "ab")
+  , ('¸', "ac")
+  , ('¨', "ad")
+  , ('ˇ', "ah")
+  , ('˚', "ao")
+  , ('~', "a~")
+  , ('˛', "ho")
+  , ('^', "ha")
+  , ('~', "ti")
+  ]
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 6acc88b3d..3b64fe5ef 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -45,7 +45,7 @@ import Control.Monad.Reader
 import Control.Monad.Except (throwError)
 import Data.Bifunctor
 import Data.Default
-import Data.List (intercalate)
+import Data.List (intercalate, transpose)
 import Data.List.Split (splitOn)
 import qualified Data.Map as M
 import qualified Data.Set as Set
@@ -135,9 +135,6 @@ parseMuse = do
 
 -- * Utility functions
 
-commonPrefix :: String -> String -> String
-commonPrefix xs ys = map fst $ takeWhile (uncurry (==)) $ zip xs ys
-
 -- | Trim up to one newline from the beginning of the string.
 lchop :: String -> String
 lchop ('\n':xs) = xs
@@ -147,11 +144,14 @@ lchop s = s
 rchop :: String -> String
 rchop = reverse . lchop . reverse
 
+unindent :: String -> String
+unindent = rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop
+
 dropSpacePrefix :: [String] -> [String]
-dropSpacePrefix lns =
-  map (drop maxIndent) lns
-  where flns = filter (not . all (== ' ')) lns
-        maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns
+dropSpacePrefix lns = drop maxIndent <$> lns
+  where isSpaceChar c = c == ' ' || c == '\t'
+        maxIndent = length $ takeWhile (isSpaceChar . head) $ takeWhile same $ transpose lns
+        same = and . (zipWith (==) <*> drop 1)
 
 atStart :: PandocMonad m => MuseParser m ()
 atStart = do
@@ -380,15 +380,15 @@ amuseHeadingUntil end = try $ do
 example :: PandocMonad m => MuseParser m (F Blocks)
 example = try $ pure . B.codeBlock
   <$  string "{{{"
-  <*  optional blankline
-  <*> manyTill anyChar (try (optional blankline *> string "}}}"))
+  <*  many spaceChar
+  <*> (unindent <$> manyTill anyChar (string "}}}"))
 
 -- | Parse an @\<example>@ tag.
 exampleTag :: PandocMonad m => MuseParser m (F Blocks)
 exampleTag = try $ fmap pure $ B.codeBlockWith
   <$  many spaceChar
   <*> (htmlAttrToPandoc <$> openTag "example")
-  <*> (rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop <$> manyTill anyChar (closeTag "example"))
+  <*> (unindent <$> manyTill anyChar (closeTag "example"))
   <*  manyTill spaceChar eol
 
 -- | Parse a @\<literal>@ tag as a raw block.
@@ -398,7 +398,7 @@ literalTag = try $ fmap pure $ B.rawBlock
   <$  many spaceChar
   <*> (fromMaybe "html" . lookup "style" <$> openTag "literal") -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML
   <*  manyTill spaceChar eol
-  <*> (rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop <$> manyTill anyChar (closeTag "literal"))
+  <*> (unindent <$> manyTill anyChar (closeTag "literal"))
   <*  manyTill spaceChar eol
 
 -- | Parse @\<center>@ tag.
diff --git a/src/Text/Pandoc/Writers/Groff.hs b/src/Text/Pandoc/Writers/Groff.hs
new file mode 100644
index 000000000..a3b81d138
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Groff.hs
@@ -0,0 +1,133 @@
+{-# 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
+    , withFontFeature
+    ) where
+import Prelude
+import Data.Char (ord, isAscii)
+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)
+import Text.Pandoc.GroffChar (essentialEscapes, characterCodes)
+
+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
+
+escapeChar :: Bool -> Char -> String
+escapeChar useAscii c =
+  case Map.lookup c essentialEscapes of
+       Just s  -> s
+       Nothing
+         | useAscii
+         , not (isAscii c) ->
+             case Map.lookup c characterCodeMap of
+                  Just t  -> "\\[" <> t <> "]"
+                  Nothing -> printf "\\[u%04X]" (ord c)
+         | otherwise -> [c]
+
+-- | Escape special characters for groff.
+escapeString :: Bool -> String -> String
+escapeString useAscii = concatMap (escapeChar useAscii)
+
+-- | Escape a literal (code) section for groff.
+escapeCode :: Bool -> String -> String
+escapeCode useAScii = intercalate "\n" . map escapeLine . lines
+  where escapeCodeChar ' '  = "\\ "
+        escapeCodeChar '\t' = "\\\t"
+        escapeCodeChar c    = escapeChar useAScii c
+        escapeLine codeline =
+          case concatMap escapeCodeChar codeline of
+            a@('.':_) -> "\\&" ++ a
+            b         -> b
+
+characterCodeMap :: Map.Map Char String
+characterCodeMap = Map.fromList characterCodes
+
+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 81fa38bd7..d2803f06f 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 =
@@ -107,8 +93,7 @@ pandocToMan opts (Pandoc meta blocks) = do
               $ defField "has-tables" hasTables
               $ defField "hyphenate" True
               $ defField "pandoc-version" pandocVersion metadata
-  (if writerPreferAscii opts then groffEscape else id) <$>
-    case writerTemplate opts of
+  case writerTemplate opts of
        Nothing  -> return main
        Just tpl -> renderTemplate' tpl context
 
@@ -127,28 +112,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.
@@ -184,8 +147,8 @@ blockToMan _ (CodeBlock _ str) = return $
   text ".IP" $$
   text ".nf" $$
   text "\\f[C]" $$
-  text (escapeCode str) $$
-  text "\\f[]" $$
+  text (escapeCode True str) $$
+  text "\\f[R]" $$
   text ".fi"
 blockToMan opts (BlockQuote blocks) = do
   contents <- blockListToMan opts blocks
@@ -332,10 +295,10 @@ inlineToMan opts (Quoted DoubleQuote lst) = do
 inlineToMan opts (Cite _ lst) =
   inlineListToMan opts lst
 inlineToMan _ (Code _ str) =
-  withFontFeature 'C' (return (text $ escapeCode str))
+  withFontFeature 'C' (return (text $ escapeCode True str))
 inlineToMan _ (Str str@('.':_)) =
-  return $ afterBreak "\\&" <> text (escapeString str)
-inlineToMan _ (Str str) = return $ text $ escapeString str
+  return $ afterBreak "\\&" <> text (escapeString True str)
+inlineToMan _ (Str str) = return $ text $ escapeString True str
 inlineToMan opts (Math InlineMath str) =
   lift (texMathToInlines InlineMath str) >>= inlineListToMan opts
 inlineToMan opts (Math DisplayMath str) = do
@@ -373,21 +336,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[" ++ 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..ec7f9bf33 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -60,41 +60,18 @@ 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 =
   evalStateT (pandocToMs opts document) defaultWriterState
 
+escString :: WriterOptions -> String -> String
+escString opts = escapeString (writerPreferAscii opts)
+
 -- | Return groff ms representation of document.
 pandocToMs :: PandocMonad m => WriterOptions -> Pandoc -> MS m Text
 pandocToMs opts (Pandoc meta blocks) = do
@@ -110,8 +87,8 @@ pandocToMs opts (Pandoc meta blocks) = do
   body <- blockListToMs opts blocks
   let main = render' body
   hasInlineMath <- gets stHasInlineMath
-  let titleMeta = (escapeString . stringify) $ docTitle meta
-  let authorsMeta = map (escapeString . stringify) $ docAuthors meta
+  let titleMeta = (escString opts . stringify) $ docTitle meta
+  let authorsMeta = map (escString opts . stringify) $ docAuthors meta
   hasHighlighting <- gets stHighlighting
   let highlightingMacros = if hasHighlighting
                               then case writerHighlightStyle opts of
@@ -127,63 +104,28 @@ pandocToMs opts (Pandoc meta blocks) = do
               $ defField "title-meta" titleMeta
               $ defField "author-meta" (intercalate "; " authorsMeta)
               $ defField "highlighting-macros" highlightingMacros metadata
-  (if writerPreferAscii opts then groffEscape else id) <$>
-    case writerTemplate opts of
+  case writerTemplate opts of
        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
 escapeBar = concatMap go
-  where go '|' = "\\[u007C]"
+  where go '|' = "\\[ba]"
         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)
+toSmallCaps :: WriterOptions -> String -> String
+toSmallCaps _ [] = []
+toSmallCaps opts (c:cs)
   | isLower c = let (lowers,rest) = span isLower (c:cs)
-                in  "\\s-2" ++ escapeString (map toUpper lowers) ++
-                    "\\s0" ++ toSmallCaps rest
+                in  "\\s-2" ++ escString opts (map toUpper lowers) ++
+                    "\\s0" ++ toSmallCaps opts rest
   | isUpper c = let (uppers,rest) = span isUpper (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
+                in  escString opts uppers ++ toSmallCaps opts rest
+  | otherwise = escapeChar (writerPreferAscii opts) c ++ toSmallCaps opts cs
 
 -- We split inline lists into sentences, and print one sentence per
 -- line.  groff/troff treats the line-ending period differently.
@@ -220,7 +162,7 @@ blockToMs opts (Para [Image attr alt (src,_tit)])
                        _ -> empty
   capt <- inlineListToMs' opts alt
   return $ nowrap (text ".PSPIC -C " <>
-             doubleQuotes (text (escapeString src)) <>
+             doubleQuotes (text (escString opts src)) <>
              sizeAttrs) $$
            text ".ce 1000" $$
            capt $$
@@ -258,7 +200,7 @@ blockToMs opts (Header level (ident,classes,_) inlines) = do
                                       (if null secnum
                                           then ""
                                           else "  ") ++
-                                      escapeString (stringify inlines))
+                                      escString opts (stringify inlines))
   let backlink = nowrap (text ".pdfhref L -D " <>
        doubleQuotes (text (toAscii ident)) <> space <> text "\\") <> cr <>
        text " -- "
@@ -460,14 +402,14 @@ inlineToMs opts (Cite _ lst) =
 inlineToMs opts (Code attr str) = do
   hlCode <- highlightCode opts attr str
   withFontFeature 'C' (return hlCode)
-inlineToMs _ (Str str) = do
+inlineToMs opts (Str str) = do
   let shim = case str of
                   '.':_ -> afterBreak "\\&"
                   _     -> empty
   smallcaps <- gets stSmallCaps
   if smallcaps
-     then return $ shim <> text (toSmallCaps str)
-     else return $ shim <> text (escapeString str)
+     then return $ shim <> text (toSmallCaps opts str)
+     else return $ shim <> text (escString opts str)
 inlineToMs opts (Math InlineMath str) = do
   modify $ \st -> st{ stHasInlineMath = True }
   res <- convertMath writeEqn InlineMath str
@@ -509,9 +451,10 @@ inlineToMs opts (Link _ txt (src, _)) = do
        doubleQuotes (text (escapeUri src)) <> text " -A " <>
        doubleQuotes (text "\\c") <> space <> text "\\") <> cr <>
        text " -- " <> doubleQuotes (nowrap contents) <> cr <> text "\\&"
-inlineToMs _ (Image _ alternate (_, _)) =
+inlineToMs opts (Image _ alternate (_, _)) =
   return $ char '[' <> text "IMAGE: " <>
-           text (escapeString (stringify alternate)) <> char ']'
+           text (escString opts (stringify alternate))
+             <> char ']'
 inlineToMs _ (Note contents) = do
   modify $ \st -> st{ stNotes = contents : stNotes st }
   return $ text "\\**"
@@ -535,28 +478,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 }
 
@@ -613,20 +534,21 @@ toMacro sty toktype =
         -- lnColor = lineNumberColor sty
         -- lnBkgColor = lineNumberBackgroundColor sty
 
-msFormatter :: FormatOptions -> [SourceLine] -> Doc
-msFormatter _fmtopts =
+msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc
+msFormatter opts _fmtopts =
   vcat . map fmtLine
   where fmtLine = hcat . map fmtToken
         fmtToken (toktype, tok) = text "\\*" <>
            brackets (text (show toktype) <> text " \""
-             <> text (escapeCode (T.unpack tok)) <> text "\"")
+             <> text (escapeCode (writerPreferAscii opts)
+                      (T.unpack tok)) <> text "\"")
 
 highlightCode :: PandocMonad m => WriterOptions -> Attr -> String -> MS m Doc
 highlightCode opts attr str =
-  case highlight (writerSyntaxMap opts) msFormatter attr str of
+  case highlight (writerSyntaxMap opts) (msFormatter opts) attr str of
          Left msg -> do
            unless (null msg) $ report $ CouldNotHighlight msg
-           return $ text (escapeCode str)
+           return $ text (escapeCode (writerPreferAscii opts) str)
          Right h -> do
            modify (\st -> st{ stHighlighting = True })
            return h
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'