diff --git a/data/templates/default.ms b/data/templates/default.ms
index 6001d81b0..d351016dd 100644
--- a/data/templates/default.ms
+++ b/data/templates/default.ms
@@ -30,7 +30,7 @@
 .\" font family: A, BM, H, HN, N, P, T, ZCM
 .fam T
 .\" paragraph indent
-.nr PI 0
+.nr PI 2m
 .\" interparagraph space
 .nr PD 0.33v
 .\" footnote width
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index 40a33b423..af31014c5 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -71,6 +71,7 @@ import Data.Char ( isLower, isUpper, toUpper )
 import Text.TeXMath (writeEqn)
 
 data WriterState = WriterState { stHasInlineMath :: Bool
+                               , stFirstPara     :: Bool
                                , stNotes         :: [Note]
                                , stInNote        :: Bool
                                , stSmallCaps     :: Bool
@@ -79,6 +80,7 @@ data WriterState = WriterState { stHasInlineMath :: Bool
 
 defaultWriterState :: WriterState
 defaultWriterState = WriterState{ stHasInlineMath = False
+                                , stFirstPara     = True
                                 , stNotes         = []
                                 , stInNote        = False
                                 , stSmallCaps     = False
@@ -209,21 +211,29 @@ blockToMs :: PandocMonad m
           -> Block         -- ^ Block element
           -> MS m Doc
 blockToMs _ Null = return empty
-blockToMs opts (Div _ bs) = blockListToMs opts bs
+blockToMs opts (Div _ bs) = do
+  setFirstPara
+  res <- blockListToMs opts bs
+  setFirstPara
+  return res
 blockToMs opts (Plain inlines) =
   liftM vcat $ mapM (inlineListToMs' opts) $ splitSentences inlines
 blockToMs opts (Para inlines) = do
+  firstPara <- gets stFirstPara
+  resetFirstPara
   contents <- liftM vcat $ mapM (inlineListToMs' opts) $
     splitSentences inlines
-  return $ text ".LP" $$ contents
+  return $ text (if firstPara then ".LP" else ".PP") $$ contents
 blockToMs _ b@(RawBlock f str)
   | f == Format "ms" = return $ text str
   | otherwise        = do
       report $ BlockNotRendered b
       return empty
-blockToMs _ HorizontalRule =
+blockToMs _ HorizontalRule = do
+  resetFirstPara
   return $ text ".HLINE"
 blockToMs opts (Header level _ inlines) = do
+  setFirstPara
   contents <- inlineListToMs' opts inlines
   let tocEntry = if writerTableOfContents opts &&
                      level <= writerTOCDepth opts
@@ -234,18 +244,24 @@ blockToMs opts (Header level _ inlines) = do
   let heading = if writerNumberSections opts
                    then ".NH"
                    else ".SH"
+  modify $ \st -> st{ stFirstPara = True }
   return $ text heading <> space <> text (show level) $$ contents $$ tocEntry
-blockToMs _ (CodeBlock _ str) = return $
-  text ".IP" $$
-  text ".nf" $$
-  text "\\f[C]" $$
-  text (escapeCode str) $$
-  text "\\f[]" $$
-  text ".fi"
+blockToMs _ (CodeBlock _ str) = do
+  setFirstPara
+  return $
+    text ".IP" $$
+    text ".nf" $$
+    text "\\f[C]" $$
+    text (escapeCode str) $$
+    text "\\f[]" $$
+    text ".fi"
 blockToMs opts (LineBlock ls) = do
+  resetFirstPara
   blockToMs opts $ Para $ intercalate [LineBreak] ls
 blockToMs opts (BlockQuote blocks) = do
+  setFirstPara
   contents <- blockListToMs opts blocks
+  setFirstPara
   return $ text ".RS" $$ contents $$ text ".RE"
 blockToMs opts (Table caption alignments widths headers rows) =
   let aligncode AlignLeft    = "l"
@@ -271,21 +287,25 @@ blockToMs opts (Table caption alignments widths headers rows) =
   body <- mapM (\row -> do
                          cols <- mapM (blockListToMs opts) row
                          return $ makeRow cols) rows
+  setFirstPara
   return $ text ".PP" $$ caption' $$
            text ".TS" $$ text "tab(@);" $$ coldescriptions $$
            colheadings' $$ vcat body $$ text ".TE"
 
 blockToMs opts (BulletList items) = do
   contents <- mapM (bulletListItemToMs opts) items
+  setFirstPara
   return (vcat contents)
 blockToMs opts (OrderedList attribs items) = do
   let markers = take (length items) $ orderedListMarkers attribs
   let indent = 1 + (maximum $ map length markers)
   contents <- mapM (\(num, item) -> orderedListItemToMs opts num indent item) $
               zip markers items
+  setFirstPara
   return (vcat contents)
 blockToMs opts (DefinitionList items) = do
   contents <- mapM (definitionListItemToMs opts) items
+  setFirstPara
   return (vcat contents)
 
 -- | Convert bullet list item (list of blocks) to ms.
@@ -344,7 +364,7 @@ definitionListItemToMs opts (label, defs) = do
                                   mapM (\item -> blockToMs opts item) rest
                         first' <- blockToMs opts first
                         return $ first' $$ text ".RS" $$ rest' $$ text ".RE"
-  return $ nowrap (text ".IP \"" <> labelText <> text "\"") $$ contents
+  return $ nowrap (text ".IP " <> doubleQuotes labelText) $$ contents
 
 -- | Convert list of Pandoc block elements to ms.
 blockListToMs :: PandocMonad m
@@ -490,3 +510,9 @@ withFontFeature c action = do
   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 }
+
+resetFirstPara :: PandocMonad m => MS m ()
+resetFirstPara = modify $ \st -> st{ stFirstPara = False }
diff --git a/test/writer.ms b/test/writer.ms
index 391223540..54c121aa4 100644
--- a/test/writer.ms
+++ b/test/writer.ms
@@ -86,7 +86,7 @@ with no blank line
 Paragraphs
 .LP
 Here's a regular paragraph.
-.LP
+.PP
 In Markdown 1.0.0 and earlier.
 Version
 8.
@@ -94,10 +94,10 @@ This line turns into a list item.
 Because a hard\-wrapped line in the
 middle of a paragraph looked like a
 list item.
-.LP
+.PP
 Here's one with a bullet.
 * criminey.
-.LP
+.PP
 There should be a hard line break
 .br
 here.
@@ -142,7 +142,7 @@ nested
 .LP
 This should not be a block quote: 2
 > 1.
-.LP
+.PP
 And a following paragraph.
 .HLINE
 .SH 1
@@ -263,7 +263,7 @@ Multiple paragraphs:
 .IP "1." 3
 Item 1, graf one.
 .RS 4
-.LP
+.PP
 Item 1.
 graf two.
 The quick brown fox jumped over the lazy dog's
@@ -382,9 +382,9 @@ Nested.
 .RE
 .LP
 Should not be a list item:
-.LP
+.PP
 M.A.\ 2007
-.LP
+.PP
 B.
 Williams
 .HLINE
@@ -437,7 +437,7 @@ Multiple blocks with italics:
 .IP "\f[I]apple\f[]"
 red fruit
 .RS
-.LP
+.PP
 contains seeds,
 crisp, pleasant to taste
 .RE
@@ -518,7 +518,7 @@ bar
 Interpreted markdown in a table:
 This is \f[I]emphasized\f[]
 And this is \f[B]strong\f[]
-.LP
+.PP
 Here's a simple block:
 .LP
 foo
@@ -545,9 +545,9 @@ Now, nested:
 foo
 .LP
 This should just be an HTML comment:
-.LP
+.PP
 Multiline:
-.LP
+.PP
 Code block:
 .IP
 .nf
@@ -557,7 +557,7 @@ Code block:
 .fi
 .LP
 Just plain comment, with trailing spaces on the line:
-.LP
+.PP
 Code:
 .IP
 .nf
@@ -572,31 +572,31 @@ Hr's:
 Inline Markup
 .LP
 This is \f[I]emphasized\f[], and so \f[I]is this\f[].
-.LP
+.PP
 This is \f[B]strong\f[], and so \f[B]is this\f[].
-.LP
+.PP
 An \f[I]emphasized link\**\f[].
 .FS
 /url
 .FE
-.LP
+.PP
 \f[B]\f[BI]This is strong and em.\f[B]\f[]
-.LP
+.PP
 So is \f[B]\f[BI]this\f[B]\f[] word.
-.LP
+.PP
 \f[B]\f[BI]This is strong and em.\f[B]\f[]
-.LP
+.PP
 So is \f[B]\f[BI]this\f[B]\f[] word.
-.LP
+.PP
 This is code: \f[C]>\f[], \f[C]$\f[], \f[C]\\\f[], \f[C]\\$\f[],
 \f[C]<html>\f[].
-.LP
+.PP
 [STRIKEOUT:This is \f[I]strikeout\f[].]
-.LP
+.PP
 Superscripts: a\*{bc\*}d a\*{\f[I]hello\f[]\*} a\*{hello\ there\*}.
-.LP
+.PP
 Subscripts: H\*<2\*>O, H\*<23\*>O, H\*<many\ of\ them\*>O.
-.LP
+.PP
 These should not be superscripts or subscripts,
 because of the unescaped spaces: a^b c^d, a~b c~d.
 .HLINE
@@ -605,24 +605,24 @@ Smart quotes, ellipses, dashes
 .LP
 \[lq]Hello,\[rq] said the spider.
 \[lq]`Shelob' is my name.\[rq]
-.LP
+.PP
 `A', `B', and `C' are letters.
-.LP
+.PP
 `Oak,' `elm,' and `beech' are names of trees.
 So is `pine.'
-.LP
+.PP
 `He said, \[lq]I want to go.\[rq]' Were you alive in the
 70's?
-.LP
+.PP
 Here is some quoted `\f[C]code\f[]' and a \[lq]quoted link\**\[rq].
 .FS
 http://example.com/?foo=1&bar=2
 .FE
-.LP
+.PP
 Some dashes: one\[em]two \[em] three\[em]four \[em] five.
-.LP
+.PP
 Dashes between numbers: 5\[en]7, 255\[en]66, 1987\[en]1999.
-.LP
+.PP
 Ellipses\&...and\&...and\&....
 .HLINE
 .SH 1
@@ -676,45 +676,45 @@ set membership: ∈
 copyright: ©
 .LP
 AT&T has an ampersand in their name.
-.LP
+.PP
 AT&T is another way to write it.
-.LP
+.PP
 This & that.
-.LP
+.PP
 4 < 5.
-.LP
+.PP
 6 > 5.
-.LP
+.PP
 Backslash: \\
-.LP
+.PP
 Backtick: `
-.LP
+.PP
 Asterisk: *
-.LP
+.PP
 Underscore: _
-.LP
+.PP
 Left brace: {
-.LP
+.PP
 Right brace: }
-.LP
+.PP
 Left bracket: [
-.LP
+.PP
 Right bracket: ]
-.LP
+.PP
 Left paren: (
-.LP
+.PP
 Right paren: )
-.LP
+.PP
 Greater\-than: >
-.LP
+.PP
 Hash: #
-.LP
+.PP
 Period: .
-.LP
+.PP
 Bang: !
-.LP
+.PP
 Plus: +
-.LP
+.PP
 Minus: \-
 .HLINE
 .SH 1
@@ -726,42 +726,42 @@ Just a URL\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 URL and title\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 URL and title\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 URL and title\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 URL and title\**
 .FS
 /url/
 .FE
-.LP
+.PP
 URL and title\**
 .FS
 /url/
 .FE
-.LP
+.PP
 with_underscore\**
 .FS
 /url/with_underscore
 .FE
-.LP
+.PP
 Email link\**
 .FS
 mailto:nobody\@nowhere.net
 .FE
-.LP
+.PP
 Empty\**.
 .FS
 .FE
@@ -772,43 +772,43 @@ Foo bar\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 Foo bar\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 Foo bar\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 With embedded [brackets]\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 b\**
 .FS
 /url/
 .FE
 by itself should be a link.
-.LP
+.PP
 Indented once\**.
 .FS
 /url
 .FE
-.LP
+.PP
 Indented twice\**.
 .FS
 /url
 .FE
-.LP
+.PP
 Indented thrice\**.
 .FS
 /url
 .FE
-.LP
+.PP
 This should [not][] be a link.
 .IP
 .nf
@@ -821,7 +821,7 @@ Foo bar\**.
 .FS
 /url/
 .FE
-.LP
+.PP
 Foo biz\**.
 .FS
 /url/
@@ -833,17 +833,17 @@ Here's a link with an ampersand in the URL\**.
 .FS
 http://example.com/?foo=1&bar=2
 .FE
-.LP
+.PP
 Here's a link with an amersand in the link text: AT&T\**.
 .FS
 http://att.com/
 .FE
-.LP
+.PP
 Here's an inline link\**.
 .FS
 /script?foo=1&bar=2
 .FE
-.LP
+.PP
 Here's an inline link in pointy braces\**.
 .FS
 /script?foo=1&bar=2
@@ -877,12 +877,12 @@ or\ here:\ <http://example.com/>
 Images
 .LP
 From \[lq]Voyage dans la Lune\[rq] by Georges Melies (1902):
-.LP
+.PP
 [IMAGE: lalune\**]
 .FS
 lalune.jpg
 .FE
-.LP
+.PP
 Here is a movie [IMAGE: movie\**]
 .FS
 movie.jpg
@@ -904,7 +904,7 @@ and another.\**
 Here's the long note.
 This one contains multiple
 blocks.
-.LP
+.PP
 Subsequent blocks are indented to show that they belong to the
 footnote (as with list items).
 .IP