Merge branch 'master' into groff_reader

2 files changed, 227 insertions, 189 deletions

diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index b5138b514..865ef1efc 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE PatternGuards #-}
 
 {-
@@ -34,6 +35,7 @@ Text.Pandoc.Writers.Powerpoint.Presentation) to a zip archive.
 module Text.Pandoc.Writers.Powerpoint.Output ( presentationToArchive
                                              ) where
 
+import Prelude
 import Control.Monad.Except (throwError, catchError)
 import Control.Monad.Reader
 import Control.Monad.State
@@ -41,7 +43,7 @@ import Codec.Archive.Zip
 import Data.Char (toUpper)
 import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse)
 import Data.Default
-import Text.Pandoc.Compat.Time (formatTime, defaultTimeLocale)
+import Data.Time (formatTime, defaultTimeLocale)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
 import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
@@ -56,7 +58,7 @@ import Text.Pandoc.MIME
 import qualified Data.ByteString.Lazy as BL
 import Text.Pandoc.Writers.OOXML
 import qualified Data.Map as M
-import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, isJust, maybeToList, catMaybes)
+import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes)
 import Text.Pandoc.ImageSize
 import Control.Applicative ((<|>))
 import System.FilePath.Glob
@@ -281,8 +283,9 @@ makeSlideIdMap (Presentation _ slides) =
 makeSpeakerNotesMap :: Presentation -> M.Map Int Int
 makeSpeakerNotesMap (Presentation _ slides) =
   M.fromList $ (mapMaybe f $ slides `zip` [1..]) `zip` [1..]
-  where f (Slide _ _ Nothing, _) = Nothing
-        f (Slide _ _ (Just _), n)  = Just n
+  where f (Slide _ _ notes, n) = if notes == mempty
+                                 then Nothing
+                                 else Just n
 
 presentationToArchive :: PandocMonad m => WriterOptions -> Presentation -> m Archive
 presentationToArchive opts pres = do
@@ -322,13 +325,11 @@ presentationToArchive opts pres = do
 -- Check to see if the presentation has speaker notes. This will
 -- influence whether we import the notesMaster template.
 presHasSpeakerNotes :: Presentation -> Bool
-presHasSpeakerNotes (Presentation _ slides) = any isJust $ map slideSpeakerNotes slides
+presHasSpeakerNotes (Presentation _ slides) = not $ all (mempty ==) $ map slideSpeakerNotes slides
 
 curSlideHasSpeakerNotes :: PandocMonad m => P m Bool
-curSlideHasSpeakerNotes = do
-  sldId <- asks envCurSlideId
-  notesIdMap <- asks envSpeakerNotesIdMap
-  return $ isJust $ M.lookup sldId notesIdMap
+curSlideHasSpeakerNotes =
+  M.member <$> asks envCurSlideId <*> asks envSpeakerNotesIdMap
 
 --------------------------------------------------
 
@@ -339,17 +340,9 @@ getLayout layout = do
         (TitleSlide _)          -> "ppt/slideLayouts/slideLayout3.xml"
         (ContentSlide _ _)      -> "ppt/slideLayouts/slideLayout2.xml"
         (TwoColumnSlide _ _ _)    -> "ppt/slideLayouts/slideLayout4.xml"
+  refArchive <- asks envRefArchive
   distArchive <- asks envDistArchive
-  root <- case findEntryByPath layoutpath distArchive of
-        Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of
-                    Just element -> return $ element
-                    Nothing      -> throwError $
-                                    PandocSomeError $
-                                    layoutpath ++ " corrupt in reference file"
-        Nothing -> throwError $
-                   PandocSomeError $
-                   layoutpath ++ " missing in reference file"
-  return root
+  parseXml refArchive distArchive layoutpath
 
 shapeHasId :: NameSpaces -> String -> Element -> Bool
 shapeHasId ns ident element
@@ -930,6 +923,13 @@ graphicFrameToElements layout tbls caption = do
             return [graphicFrameElts, capElt]
     else return [graphicFrameElts]
 
+getDefaultTableStyle :: PandocMonad m => P m (Maybe String)
+getDefaultTableStyle = do
+  refArchive <- asks envRefArchive
+  distArchive <- asks envDistArchive
+  tblStyleLst <- parseXml refArchive distArchive "ppt/tableStyles.xml"
+  return $ findAttr (QName "def" Nothing Nothing) tblStyleLst
+
 graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
 graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
   let colWidths = if null hdrCells
@@ -967,12 +967,19 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
   let mkgridcol w = mknode "a:gridCol"
                        [("w", show ((12700 * w) :: Integer))] ()
   let hasHeader = not (all null hdrCells)
+
+  mbDefTblStyle <- getDefaultTableStyle
+  let tblPrElt = mknode "a:tblPr"
+                 [ ("firstRow", if tblPrFirstRow tblPr then "1" else "0")
+                 , ("bandRow", if tblPrBandRow tblPr then "1" else "0")
+                 ] (case mbDefTblStyle of
+                      Nothing -> []
+                      Just sty -> [mknode "a:tableStyleId" [] sty])
+
   return $ mknode "a:graphic" [] $
     [mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")] $
      [mknode "a:tbl" [] $
-      [ mknode "a:tblPr" [ ("firstRow", if tblPrFirstRow tblPr then "1" else "0")
-                         , ("bandRow", if tblPrBandRow tblPr then "1" else "0")
-                         ] ()
+      [ tblPrElt
       , mknode "a:tblGrid" [] (if all (==0) colWidths
                                then []
                                else map mkgridcol colWidths)
@@ -994,6 +1001,14 @@ getShapeByPlaceHolderType ns spTreeElem phType
       filterChild findPhType spTreeElem
   | otherwise = Nothing
 
+-- Like the above, but it tries a number of different placeholder types
+getShapeByPlaceHolderTypes :: NameSpaces -> Element -> [String] -> Maybe Element
+getShapeByPlaceHolderTypes _ _ [] = Nothing
+getShapeByPlaceHolderTypes ns spTreeElem (s:ss) =
+  case getShapeByPlaceHolderType ns spTreeElem s of
+    Just element -> Just element
+    Nothing -> getShapeByPlaceHolderTypes ns spTreeElem ss
+
 getShapeByPlaceHolderIndex :: NameSpaces -> Element -> String -> Maybe Element
 getShapeByPlaceHolderIndex ns spTreeElem phIdx
   | isElem ns "p" "spTree" spTreeElem =
@@ -1008,12 +1023,12 @@ getShapeByPlaceHolderIndex ns spTreeElem phIdx
   | otherwise = Nothing
 
 
-nonBodyTextToElement :: PandocMonad m => Element -> String -> [ParaElem] -> P m Element
-nonBodyTextToElement layout phType paraElements
+nonBodyTextToElement :: PandocMonad m => Element -> [String] -> [ParaElem] -> P m Element
+nonBodyTextToElement layout phTypes paraElements
   | ns <- elemToNameSpaces layout
   , Just cSld <- findChild (elemName ns "p" "cSld") layout
   , Just spTree <- findChild (elemName ns "p" "spTree") cSld
-  , Just sp <- getShapeByPlaceHolderType ns spTree phType = do
+  , Just sp <- getShapeByPlaceHolderTypes ns spTree phTypes = do
       let hdrPara = Paragraph def paraElements
       element <- paragraphToElement hdrPara
       let txBody = mknode "p:txBody" [] $
@@ -1028,7 +1043,7 @@ contentToElement layout hdrShape shapes
   | ns <- elemToNameSpaces layout
   , Just cSld <- findChild (elemName ns "p" "cSld") layout
   , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
-      element <- nonBodyTextToElement layout "title" hdrShape
+      element <- nonBodyTextToElement layout ["title"] hdrShape
       let hdrShapeElements = if null hdrShape
                              then []
                              else [element]
@@ -1046,7 +1061,7 @@ twoColumnToElement layout hdrShape shapesL shapesR
   | ns <- elemToNameSpaces layout
   , Just cSld <- findChild (elemName ns "p" "cSld") layout
   , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
-      element <- nonBodyTextToElement layout "title" hdrShape
+      element <- nonBodyTextToElement layout ["title"] hdrShape
       let hdrShapeElements = if null hdrShape
                              then []
                              else [element]
@@ -1070,7 +1085,7 @@ titleToElement layout titleElems
   | ns <- elemToNameSpaces layout
   , Just cSld <- findChild (elemName ns "p" "cSld") layout
   , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
-      element <- nonBodyTextToElement layout "title" titleElems
+      element <- nonBodyTextToElement layout ["title", "ctrTitle"] titleElems
       let titleShapeElements = if null titleElems
                                then []
                                else [element]
@@ -1084,15 +1099,15 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
   , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
       titleShapeElements <- if null titleElems
                             then return []
-                            else sequence [nonBodyTextToElement layout "ctrTitle" titleElems]
+                            else sequence [nonBodyTextToElement layout ["ctrTitle"] titleElems]
       let combinedAuthorElems = intercalate [Break] authorsElems
           subtitleAndAuthorElems = intercalate [Break, Break] [subtitleElems, combinedAuthorElems]
       subtitleShapeElements <- if null subtitleAndAuthorElems
                                then return []
-                               else sequence [nonBodyTextToElement layout "subTitle" subtitleAndAuthorElems]
+                               else sequence [nonBodyTextToElement layout ["subTitle"] subtitleAndAuthorElems]
       dateShapeElements <- if null dateElems
                            then return []
-                           else sequence [nonBodyTextToElement layout "dt" dateElems]
+                           else sequence [nonBodyTextToElement layout ["dt"] dateElems]
       return $ replaceNamedChildren ns "p" "sp"
         (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements)
         spTree
@@ -1144,18 +1159,9 @@ slideToElement (Slide _ l@(MetadataSlide titleElems subtitleElems authorElems da
 
 getNotesMaster :: PandocMonad m => P m Element
 getNotesMaster = do
-  let notesMasterPath = "ppt/notesMasters/notesMaster1.xml"
+  refArchive <- asks envRefArchive
   distArchive <- asks envDistArchive
-  root <- case findEntryByPath notesMasterPath distArchive of
-        Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of
-                    Just element -> return $ element
-                    Nothing      -> throwError $
-                                    PandocSomeError $
-                                    notesMasterPath ++ " corrupt in reference file"
-        Nothing -> throwError $
-                   PandocSomeError $
-                   notesMasterPath ++ " missing in reference file"
-  return root
+  parseXml refArchive distArchive "ppt/notesMasters/notesMaster1.xml"
 
 getSlideNumberFieldId :: PandocMonad m => Element -> P m String
 getSlideNumberFieldId notesMaster
@@ -1256,42 +1262,40 @@ speakerNotesSlideNumber pgNum fieldId =
   ]
 
 slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
-slideToSpeakerNotesElement slide
-  | Slide _ _ mbNotes <- slide
-  , Just (SpeakerNotes paras) <- mbNotes = do
-      master <- getNotesMaster
-      fieldId  <- getSlideNumberFieldId master
-      num <- slideNum slide
-      let imgShape = speakerNotesSlideImage
-          sldNumShape = speakerNotesSlideNumber num fieldId
-      bodyShape <- speakerNotesBody paras
-      return $ Just $
-        mknode "p:notes"
-        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
-        , ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
-        , ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
-        ] [ mknode "p:cSld" []
-            [ mknode "p:spTree" []
-              [ mknode "p:nvGrpSpPr" []
-                [ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
-                , mknode "p:cNvGrpSpPr" [] ()
-                , mknode "p:nvPr" [] ()
-                ]
-            , mknode "p:grpSpPr" []
-              [ mknode "a:xfrm" []
-                [ mknode "a:off" [("x", "0"), ("y", "0")] ()
-                , mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
-                , mknode "a:chOff" [("x", "0"), ("y", "0")] ()
-                , mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
-                ]
-              ]
-            , imgShape
-            , bodyShape
-            , sldNumShape
+slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes [])) = return Nothing
+slideToSpeakerNotesElement slide@(Slide _ _ (SpeakerNotes paras)) = do
+  master <- getNotesMaster
+  fieldId  <- getSlideNumberFieldId master
+  num <- slideNum slide
+  let imgShape = speakerNotesSlideImage
+      sldNumShape = speakerNotesSlideNumber num fieldId
+  bodyShape <- speakerNotesBody paras
+  return $ Just $
+    mknode "p:notes"
+    [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
+    , ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
+    , ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
+    ] [ mknode "p:cSld" []
+        [ mknode "p:spTree" []
+          [ mknode "p:nvGrpSpPr" []
+            [ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
+            , mknode "p:cNvGrpSpPr" [] ()
+            , mknode "p:nvPr" [] ()
             ]
+          , mknode "p:grpSpPr" []
+            [ mknode "a:xfrm" []
+              [ mknode "a:off" [("x", "0"), ("y", "0")] ()
+              , mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
+              , mknode "a:chOff" [("x", "0"), ("y", "0")] ()
+              , mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
+              ]
             ]
+          , imgShape
+          , bodyShape
+          , sldNumShape
           ]
-slideToSpeakerNotesElement _ = return Nothing
+        ]
+      ]
 
 -----------------------------------------------------------------------
 
@@ -1466,23 +1470,22 @@ slideToSpeakerNotesEntry slide = do
       _ -> return Nothing
 
 slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
-slideToSpeakerNotesRelElement slide
-  | Slide _ _ mbNotes <- slide
-  , Just _ <- mbNotes = do
-      idNum <- slideNum slide
-      return $ Just $
-        mknode "Relationships"
-        [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
-        [ mknode "Relationship" [ ("Id", "rId2")
-                                , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
-                                , ("Target", "../slides/slide" ++ show idNum ++ ".xml")
-                                ] ()
-        , mknode "Relationship" [ ("Id", "rId1")
-                                , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
-                                , ("Target", "../notesMasters/notesMaster1.xml")
-                                ] ()
-        ]
-slideToSpeakerNotesRelElement _ = return Nothing
+slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes [])) = return Nothing
+slideToSpeakerNotesRelElement slide@(Slide _ _ _) = do
+  idNum <- slideNum slide
+  return $ Just $
+    mknode "Relationships"
+    [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
+    [ mknode "Relationship" [ ("Id", "rId2")
+                            , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
+                            , ("Target", "../slides/slide" ++ show idNum ++ ".xml")
+                            ] ()
+    , mknode "Relationship" [ ("Id", "rId1")
+                            , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
+                            , ("Target", "../notesMasters/notesMaster1.xml")
+                            ] ()
+    ]
+
 
 slideToSpeakerNotesRelEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
 slideToSpeakerNotesRelEntry slide = do
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index ac7c86945..e14476b16 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {-
 Copyright (C) 2017-2018 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -57,6 +59,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
                                                    ) where
 
 
+import Prelude
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.List (intercalate)
@@ -67,7 +70,7 @@ import Text.Pandoc.Slides (getSlideLevel)
 import Text.Pandoc.Options
 import Text.Pandoc.Logging
 import Text.Pandoc.Walk
-import Text.Pandoc.Compat.Time (UTCTime)
+import Data.Time (UTCTime)
 import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
 import Text.Pandoc.Writers.Shared (metaValueToInlines)
 import qualified Data.Map as M
@@ -110,7 +113,7 @@ data WriterState = WriterState { stNoteIds :: M.Map Int [Block]
                                , stAnchorMap :: M.Map String SlideId
                                , stSlideIdSet :: S.Set SlideId
                                , stLog :: [LogMessage]
-                               , stSpeakerNotesMap :: M.Map SlideId [[Paragraph]]
+                               , stSpeakerNotes :: SpeakerNotes
                                } deriving (Show, Eq)
 
 instance Default WriterState where
@@ -119,7 +122,7 @@ instance Default WriterState where
                     -- we reserve this s
                     , stSlideIdSet = reservedSlideIds
                     , stLog = []
-                    , stSpeakerNotesMap = mempty
+                    , stSpeakerNotes = mempty
                     }
 
 metadataSlideId :: SlideId
@@ -183,7 +186,7 @@ data DocProps = DocProps { dcTitle :: Maybe String
 
 data Slide = Slide { slideId :: SlideId
                    , slideLayout :: Layout
-                   , slideSpeakerNotes :: Maybe SpeakerNotes
+                   , slideSpeakerNotes :: SpeakerNotes
                    } deriving (Show, Eq)
 
 newtype SlideId = SlideId String
@@ -193,7 +196,7 @@ newtype SlideId = SlideId String
 -- designed mainly for one textbox, so we'll just put in the contents
 -- of that textbox, to avoid other shapes that won't work as well.
 newtype SpeakerNotes = SpeakerNotes {fromSpeakerNotes :: [Paragraph]}
-  deriving (Show, Eq)
+  deriving (Show, Eq, Monoid, Semigroup)
 
 data Layout = MetadataSlide { metadataSlideTitle :: [ParaElem]
                             , metadataSlideSubtitle :: [ParaElem]
@@ -229,7 +232,6 @@ data Paragraph = Paragraph { paraProps :: ParaProps
                            , paraElems  :: [ParaElem]
                            } deriving (Show, Eq)
 
-
 data BulletType = Bullet
                 | AutoNumbering ListAttributes
   deriving (Show, Eq)
@@ -374,9 +376,20 @@ inlineToParElems (Note blks) = do
     modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes }
     local (\env -> env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) $
       inlineToParElems $ Superscript [Str $ show curNoteId]
-inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils
+inlineToParElems (Span _ ils) = inlinesToParElems ils
+inlineToParElems (Quoted quoteType ils) =
+  inlinesToParElems $ [Str open] ++ ils ++ [Str close]
+  where (open, close) = case quoteType of
+                          SingleQuote -> ("\x2018", "\x2019")
+                          DoubleQuote -> ("\x201C", "\x201D")
 inlineToParElems (RawInline _ _) = return []
-inlineToParElems _ = return []
+inlineToParElems (Cite _ ils) = inlinesToParElems ils
+-- Note: we shouldn't reach this, because images should be handled at
+-- the shape level, but should that change in the future, we render
+-- the alt text.
+inlineToParElems (Image _ alt _) = inlinesToParElems alt
+
+
 
 isListType :: Block -> Bool
 isListType (OrderedList _ _) = True
@@ -399,10 +412,7 @@ noteSize :: Pixels
 noteSize = 18
 
 blockToParagraphs :: Block -> Pres [Paragraph]
-blockToParagraphs (Plain ils) = do
-  parElems <- inlinesToParElems ils
-  pProps <- asks envParaProps
-  return [Paragraph pProps parElems]
+blockToParagraphs (Plain ils) = blockToParagraphs (Para ils)
 blockToParagraphs (Para ils) = do
   parElems <- inlinesToParElems ils
   pProps <- asks envParaProps
@@ -475,16 +485,6 @@ blockToParagraphs (DefinitionList entries) = do
         definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst
         return $ term ++ definition
   concatMapM go entries
-blockToParagraphs (Div (_, "notes" : [], _) blks) =
-  local (\env -> env{envInSpeakerNotes=True}) $ do
-  sldId <- asks envCurSlideId
-  spkNotesMap <- gets stSpeakerNotesMap
-  paras <- concatMapM blockToParagraphs blks
-  let spkNotesMap' = case M.lookup sldId spkNotesMap of
-        Just lst -> M.insert sldId (paras : lst) spkNotesMap
-        Nothing  -> M.insert sldId [paras] spkNotesMap
-  modify $ \st -> st{stSpeakerNotesMap = spkNotesMap'}
-  return []
 blockToParagraphs (Div _ blks)  = concatMapM blockToParagraphs blks
 blockToParagraphs blk = do
   addLogMessage $ BlockNotRendered blk
@@ -527,14 +527,9 @@ withAttr attr (Pic picPr url caption) =
 withAttr _ sp = sp
 
 blockToShape :: Block -> Pres Shape
-blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il =
-      (withAttr attr . Pic def url) <$> inlinesToParElems ils
+blockToShape (Plain ils) = blockToShape (Para ils)
 blockToShape (Para (il:_))  | Image attr ils (url, _) <- il =
       (withAttr attr . Pic def url) <$> inlinesToParElems ils
-blockToShape (Plain (il:_)) | Link _ (il':_) target <- il
-                            , Image attr ils (url, _) <- il' =
-      (withAttr attr . Pic def {picPropLink = Just $ ExternalTarget target} url) <$>
-      inlinesToParElems ils
 blockToShape (Para (il:_))  | Link _ (il':_) target <- il
                             , Image attr ils (url, _) <- il' =
       (withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} url) <$>
@@ -558,20 +553,23 @@ blockToShape blk = do paras <- blockToParagraphs blk
 
 combineShapes :: [Shape] -> [Shape]
 combineShapes [] = []
-combineShapes[s] = [s]
-combineShapes (pic@(Pic{}) : ss) = pic : combineShapes ss
+combineShapes (pic@Pic{} : ss) = pic : combineShapes ss
 combineShapes (TextBox [] : ss) = combineShapes ss
 combineShapes (s : TextBox [] : ss) = combineShapes (s : ss)
 combineShapes (TextBox (p:ps) : TextBox (p':ps') : ss) =
   combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss
 combineShapes (s:ss) = s : combineShapes ss
 
+isNotesDiv :: Block -> Bool
+isNotesDiv (Div (_, ["notes"], _) _) = True
+isNotesDiv _ = False
+
 blocksToShapes :: [Block] -> Pres [Shape]
 blocksToShapes blks = combineShapes <$> mapM blockToShape blks
 
 isImage :: Inline -> Bool
-isImage (Image{}) = True
-isImage (Link _ (Image _ _ _ : _) _) = True
+isImage Image{} = True
+isImage (Link _ (Image{} : _) _) = True
 isImage _ = False
 
 splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
@@ -589,64 +587,60 @@ splitBlocks' cur acc (h@(Header n _ _) : blks) = do
 splitBlocks' cur acc (Plain ils : blks) = splitBlocks' cur acc (Para ils : blks)
 splitBlocks' cur acc (Para (il:ils) : blks) | isImage il = do
   slideLevel <- asks envSlideLevel
+  let (nts, blks') = if null ils
+                     then span isNotesDiv blks
+                     else ([], blks)
   case cur of
-    [(Header n _ _)] | n == slideLevel ->
+    [Header n _ _] | n == slideLevel ->
                             splitBlocks' []
-                            (acc ++ [cur ++ [Para [il]]])
-                            (if null ils then blks else Para ils : blks)
+                            (acc ++ [cur ++ [Para [il]] ++ nts])
+                            (if null ils then blks' else Para ils : blks')
     _ -> splitBlocks' []
-         (acc ++ (if null cur then [] else [cur]) ++ [[Para [il]]])
-         (if null ils then blks else Para ils : blks)
-splitBlocks' cur acc (tbl@(Table{}) : blks) = do
+         (acc ++ (if null cur then [] else [cur]) ++ [[Para [il]] ++ nts])
+         (if null ils then blks' else Para ils : blks')
+splitBlocks' cur acc (tbl@Table{} : blks) = do
   slideLevel <- asks envSlideLevel
+  let (nts, blks') = span isNotesDiv blks
   case cur of
-    [(Header n _ _)] | n == slideLevel ->
-                            splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks
-    _ ->  splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl]]) blks
+    [Header n _ _] | n == slideLevel ->
+                            splitBlocks' [] (acc ++ [cur ++ [tbl] ++ nts]) blks'
+    _ ->  splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[tbl] ++ nts]) blks'
 splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classes =  do
   slideLevel <- asks envSlideLevel
+  let (nts, blks') = span isNotesDiv blks
   case cur of
-    [(Header n _ _)] | n == slideLevel ->
-                            splitBlocks' [] (acc ++ [cur ++ [d]]) blks
-    _ ->  splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d]]) blks
+    [Header n _ _] | n == slideLevel ->
+                            splitBlocks' [] (acc ++ [cur ++ [d] ++ nts]) blks'
+    _ ->  splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d] ++ nts]) blks'
 splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
 
 splitBlocks :: [Block] -> Pres [[Block]]
 splitBlocks = splitBlocks' [] []
 
-getSpeakerNotes :: Pres (Maybe SpeakerNotes)
-getSpeakerNotes = do
-  sldId <- asks envCurSlideId
-  spkNtsMap <- gets stSpeakerNotesMap
-  return $ (SpeakerNotes . concat . reverse) <$> (M.lookup sldId spkNtsMap)
-
-blocksToSlide' :: Int -> [Block] -> Pres Slide
-blocksToSlide' lvl (Header n (ident, _, _) ils : blks)
+blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
+blocksToSlide' lvl (Header n (ident, _, _) ils : blks) spkNotes
   | n < lvl = do
       registerAnchorId ident
       sldId <- asks envCurSlideId
       hdr <- inlinesToParElems ils
-      return $ Slide sldId TitleSlide {titleSlideHeader = hdr} Nothing
+      return $ Slide sldId TitleSlide {titleSlideHeader = hdr} spkNotes
   | n == lvl = do
       registerAnchorId ident
       hdr <- inlinesToParElems ils
       -- Now get the slide without the header, and then add the header
       -- in.
-      slide <- blocksToSlide' lvl blks
+      slide <- blocksToSlide' lvl blks spkNotes
       let layout = case slideLayout slide of
             ContentSlide _ cont          -> ContentSlide hdr cont
             TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR
             layout'                     -> layout'
       return $ slide{slideLayout = layout}
-blocksToSlide' _ (blk : blks)
+blocksToSlide' _ (blk : blks) spkNotes
   | Div (_, classes, _) divBlks <- blk
   , "columns" `elem` classes
   , Div (_, clsL, _) blksL : Div (_, clsR, _) blksR : remaining <- divBlks
   , "column" `elem` clsL, "column" `elem` clsR = do
-      unless (null blks)
-        (mapM (addLogMessage . BlockNotRendered) blks >> return ())
-      unless (null remaining)
-        (mapM (addLogMessage . BlockNotRendered) remaining >> return ())
+      mapM_ (addLogMessage . BlockNotRendered) (blks ++ remaining)
       mbSplitBlksL <- splitBlocks blksL
       mbSplitBlksR <- splitBlocks blksR
       let blksL' = case mbSplitBlksL of
@@ -664,8 +658,8 @@ blocksToSlide' _ (blk : blks)
                        , twoColumnSlideLeft = shapesL
                        , twoColumnSlideRight = shapesR
                        }
-        Nothing
-blocksToSlide' _ (blk : blks) = do
+        spkNotes
+blocksToSlide' _ (blk : blks) spkNotes = do
       inNoteSlide <- asks envInNoteSlide
       shapes <- if inNoteSlide
                 then forceFontSize noteSize $ blocksToShapes (blk : blks)
@@ -677,8 +671,8 @@ blocksToSlide' _ (blk : blks) = do
         ContentSlide { contentSlideHeader = []
                      , contentSlideContent = shapes
                      }
-        Nothing
-blocksToSlide' _ [] = do
+        spkNotes
+blocksToSlide' _ [] spkNotes = do
   sldId <- asks envCurSlideId
   return $
     Slide
@@ -686,14 +680,32 @@ blocksToSlide' _ [] = do
     ContentSlide { contentSlideHeader = []
                  , contentSlideContent = []
                  }
-    Nothing
+    spkNotes
+
+handleNotes :: Block -> Pres ()
+handleNotes (Div (_, ["notes"], _) blks) =
+  local (\env -> env{envInSpeakerNotes=True}) $ do
+  spNotes <- SpeakerNotes <$> concatMapM blockToParagraphs blks
+  modify $ \st -> st{stSpeakerNotes = (stSpeakerNotes st) <> spNotes}
+handleNotes _ = return ()
+
+handleAndFilterNotes' :: [Block] -> Pres [Block]
+handleAndFilterNotes' blks = do
+  mapM_ handleNotes blks
+  return $ filter (not . isNotesDiv) blks
+
+handleAndFilterNotes :: [Block] -> Pres ([Block], SpeakerNotes)
+handleAndFilterNotes blks = do
+  modify $ \st -> st{stSpeakerNotes = mempty}
+  blks' <- walkM handleAndFilterNotes' blks
+  spkNotes <- gets stSpeakerNotes
+  return (blks', spkNotes)
 
 blocksToSlide :: [Block] -> Pres Slide
 blocksToSlide blks = do
+  (blks', spkNotes) <- handleAndFilterNotes blks
   slideLevel <- asks envSlideLevel
-  sld <- blocksToSlide' slideLevel blks
-  spkNotes <- getSpeakerNotes
-  return $ sld{slideSpeakerNotes = spkNotes}
+  blocksToSlide' slideLevel blks' spkNotes
 
 makeNoteEntry :: Int -> [Block] -> [Block]
 makeNoteEntry n blks =
@@ -719,15 +731,14 @@ makeEndNotesSlideBlocks = do
   anchorSet <- M.keysSet <$> gets stAnchorMap
   if M.null noteIds
     then return []
-    else do let title = case lookupMeta "notes-title" meta of
-                  Just val -> metaValueToInlines val
-                  Nothing  -> [Str "Notes"]
-                ident = Shared.uniqueIdent title anchorSet
-                hdr = Header slideLevel (ident, [], []) title
-            blks <- return $
-                    concatMap (\(n, bs) -> makeNoteEntry n bs) $
+    else let title = case lookupMeta "notes-title" meta of
+                       Just val -> metaValueToInlines val
+                       Nothing  -> [Str "Notes"]
+             ident = Shared.uniqueIdent title anchorSet
+             hdr = Header slideLevel (ident, [], []) title
+             blks = concatMap (\(n, bs) -> makeNoteEntry n bs) $
                     M.toList noteIds
-            return $ hdr : blks
+         in return $ hdr : blks
 
 getMetaSlide :: Pres (Maybe Slide)
 getMetaSlide  = do
@@ -753,7 +764,7 @@ getMetaSlide  = do
                        , metadataSlideAuthors = authors
                        , metadataSlideDate = date
                        }
-         Nothing
+         mempty
 
 -- adapted from the markdown writer
 elementToListItem :: Shared.Element -> Pres [Block]
@@ -778,8 +789,7 @@ makeTOCSlide blks = local (\env -> env{envCurSlideId = tocSlideId}) $ do
                    Just val -> metaValueToInlines val
                    Nothing  -> [Str "Table of Contents"]
       hdr = Header slideLevel nullAttr tocTitle
-  sld <- blocksToSlide [hdr, contents]
-  return sld
+  blocksToSlide [hdr, contents]
 
 combineParaElems' :: Maybe ParaElem -> [ParaElem] -> [ParaElem]
 combineParaElems' mbPElem [] = maybeToList mbPElem
@@ -802,15 +812,9 @@ applyToParagraph f para = do
   return $ para {paraElems = paraElems'}
 
 applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
-applyToShape f (Pic pPr fp pes) = do
-  pes' <- mapM f pes
-  return $ Pic pPr fp pes'
-applyToShape f (GraphicFrame gfx pes) = do
-  pes' <- mapM f pes
-  return $ GraphicFrame gfx pes'
-applyToShape f (TextBox paras) = do
-  paras' <- mapM (applyToParagraph f) paras
-  return $ TextBox paras'
+applyToShape f (Pic pPr fp pes) = Pic pPr fp <$> mapM f pes
+applyToShape f (GraphicFrame gfx pes) = GraphicFrame gfx <$> mapM f pes
+applyToShape f (TextBox paras) = TextBox <$> mapM (applyToParagraph f) paras
 
 applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout
 applyToLayout f (MetadataSlide title subtitle authors date) = do
@@ -819,9 +823,7 @@ applyToLayout f (MetadataSlide title subtitle authors date) = do
   authors' <- mapM (mapM f) authors
   date' <- mapM f date
   return $ MetadataSlide title' subtitle' authors' date'
-applyToLayout f (TitleSlide title) = do
-  title' <- mapM f title
-  return $ TitleSlide title'
+applyToLayout f (TitleSlide title) = TitleSlide <$> mapM f title
 applyToLayout f (ContentSlide hdr content) = do
   hdr' <- mapM f hdr
   content' <- mapM (applyToShape f) content
@@ -835,11 +837,9 @@ applyToLayout f (TwoColumnSlide hdr contentL contentR) = do
 applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
 applyToSlide f slide = do
   layout' <- applyToLayout f $ slideLayout slide
-  mbNotes' <- case slideSpeakerNotes slide of
-                Just (SpeakerNotes notes) -> (Just . SpeakerNotes) <$>
-                                             mapM (applyToParagraph f) notes
-                Nothing -> return Nothing
-  return slide{slideLayout = layout', slideSpeakerNotes = mbNotes'}
+  let paras = fromSpeakerNotes $ slideSpeakerNotes slide
+  notes' <- SpeakerNotes <$> mapM (applyToParagraph f) paras
+  return slide{slideLayout = layout', slideSpeakerNotes = notes'}
 
 replaceAnchor :: ParaElem -> Pres ParaElem
 replaceAnchor (Run rProps s)
@@ -853,6 +853,40 @@ replaceAnchor (Run rProps s)
       return $ Run rProps' s
 replaceAnchor pe = return pe
 
+emptyParaElem :: ParaElem -> Bool
+emptyParaElem (Run _ s) =
+  null $ Shared.trim s
+emptyParaElem (MathElem _ ts) =
+  null $ Shared.trim $ unTeXString ts
+emptyParaElem _ = False
+
+emptyParagraph :: Paragraph -> Bool
+emptyParagraph para = all emptyParaElem $ paraElems para
+
+
+emptyShape :: Shape -> Bool
+emptyShape (TextBox paras) = all emptyParagraph paras
+emptyShape _ = False
+
+emptyLayout :: Layout -> Bool
+emptyLayout layout = case layout of
+  MetadataSlide title subtitle authors date ->
+    all emptyParaElem title &&
+    all emptyParaElem subtitle &&
+    all (all emptyParaElem) authors &&
+    all emptyParaElem date
+  TitleSlide hdr -> all emptyParaElem hdr
+  ContentSlide hdr shapes ->
+    all emptyParaElem hdr &&
+    all emptyShape shapes
+  TwoColumnSlide hdr shapes1 shapes2 ->
+    all emptyParaElem hdr &&
+    all emptyShape shapes1 &&
+    all emptyShape shapes2
+
+emptySlide :: Slide -> Bool
+emptySlide (Slide _ layout notes) = (notes == mempty) && (emptyLayout layout)
+
 blocksToPresentationSlides :: [Block] -> Pres [Slide]
 blocksToPresentationSlides blks = do
   opts <- asks envOpts
@@ -893,7 +927,8 @@ blocksToPresentationSlides blks = do
                             return [endNotesSlide]
 
   let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides
-  mapM (applyToSlide replaceAnchor) slides
+      slides' = filter (not . emptySlide) slides
+  mapM (applyToSlide replaceAnchor) slides'
 
 metaToDocProps :: Meta -> DocProps
 metaToDocProps meta =