diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Org.hs')
-rw-r--r-- | src/Text/Pandoc/Writers/Org.hs | 148 |
1 files changed, 69 insertions, 79 deletions
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 862628f9d..59f7e14f5 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2006-2010 Puneeth Chaganti <punchagan@gmail.com> @@ -32,10 +33,9 @@ Org-Mode: <http://orgmode.org> module Text.Pandoc.Writers.Org ( writeOrg) where import Text.Pandoc.Definition import Text.Pandoc.Shared -import Text.Pandoc.Blocks +import Text.Pandoc.Pretty import Text.Pandoc.Templates (renderTemplate) import Data.List ( intersect, intersperse, transpose ) -import Text.PrettyPrint.HughesPJ hiding ( Str ) import Control.Monad.State import Control.Applicative ( (<$>) ) @@ -66,13 +66,16 @@ pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do notes <- liftM (reverse . stNotes) get >>= notesToOrg -- note that the notes may contain refs, so we do them first hasMath <- liftM stHasMath get - let main = render $ foldl ($+$) empty $ [body, notes] + let colwidth = if writerWrapText opts + then Just $ writerColumns opts + else Nothing + let main = render colwidth $ foldl ($+$) empty $ [body, notes] let context = writerVariables opts ++ [ ("body", main) - , ("title", render title) - , ("date", render date) ] ++ + , ("title", render Nothing title) + , ("date", render Nothing date) ] ++ [ ("math", "yes") | hasMath ] ++ - [ ("author", render a) | a <- authors ] + [ ("author", render Nothing a) | a <- authors ] if writerStandalone opts then return $ renderTemplate context $ writerTemplate opts else return main @@ -81,22 +84,14 @@ pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do notesToOrg :: [[Block]] -> State WriterState Doc notesToOrg notes = mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>= - return . vcat + return . vsep -- | Return Org representation of a note. noteToOrg :: Int -> [Block] -> State WriterState Doc noteToOrg num note = do contents <- blockListToOrg note - let marker = text "[" <> text (show num) <> text "] " - return $ marker <> contents - --- | Take list of inline elements and return wrapped doc. -wrappedOrg :: WriterOptions -> [Inline] -> State WriterState Doc -wrappedOrg opts inlines = do - lineBreakDoc <- inlineToOrg LineBreak - chunks <- mapM (wrapIfNeeded opts inlineListToOrg) - (splitBy LineBreak inlines) - return $ vcat $ intersperse lineBreakDoc chunks + let marker = "[" ++ show num ++ "] " + return $ hang (length marker) (text marker) contents -- | Escape special characters for Org. escapeString :: String -> String @@ -106,32 +101,28 @@ titleToOrg :: [Inline] -> State WriterState Doc titleToOrg [] = return empty titleToOrg lst = do contents <- inlineListToOrg lst - let titleName = text "#+TITLE: " - return $ titleName <> contents + return $ "#+TITLE: " <> contents -- | Convert Pandoc block element to Org. blockToOrg :: Block -- ^ Block element -> State WriterState Doc blockToOrg Null = return empty -blockToOrg (Plain inlines) = do - opts <- get >>= (return . stOptions) - wrappedOrg opts inlines +blockToOrg (Plain inlines) = inlineListToOrg inlines blockToOrg (Para [Image txt (src,tit)]) = do capt <- inlineListToOrg txt img <- inlineToOrg (Image txt (src,tit)) - return $ text "#+CAPTION: " <> capt <> text "\n" $$ img + return $ "#+CAPTION: " <> capt <> blankline <> img blockToOrg (Para inlines) = do - opts <- get >>= (return . stOptions) - contents <- wrappedOrg opts inlines - return $ contents <> text "\n" + contents <- inlineListToOrg inlines + return $ contents <> blankline blockToOrg (RawHtml str) = - return $ (text "\n#+BEGIN_HTML\n") $$ (nest 2 $ vcat $ map text (lines str)) - $$ (text "\n#+END_HTML\n") -blockToOrg HorizontalRule = return $ text "--------------\n" + return $ blankline $$ "#+BEGIN_HTML" $$ + nest 2 (text str) $$ "#+END_HTML" $$ blankline +blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline blockToOrg (Header level inlines) = do contents <- inlineListToOrg inlines let headerStr = text $ if level > 999 then " " else replicate level '*' - return $ headerStr <> text " " <> contents <> text "\n" + return $ headerStr <> " " <> contents <> blankline blockToOrg (CodeBlock (_,classes,_) str) = do opts <- stOptions <$> get let tabstop = writerTabStop opts @@ -143,31 +134,30 @@ blockToOrg (CodeBlock (_,classes,_) str) = do let (beg, end) = if null at then ("#+BEGIN_EXAMPLE", "#+END_EXAMPLE") else ("#+BEGIN_SRC" ++ head at, "#+END_SRC") - return $ text beg $+$ (nest tabstop $ vcat $ map text (lines str)) - $+$ text end + return $ text beg $$ nest tabstop (text str) $$ text end $$ blankline blockToOrg (BlockQuote blocks) = do contents <- blockListToOrg blocks - return $ (text "\n#+BEGIN_QUOTE\n") $$ (nest 2 contents) - $$ (text "\n#+END_QUOTE\n") + return $ blankline $$ "#+BEGIN_QUOTE" $$ + nest 2 contents $$ "#+END_QUOTE" $$ blankline blockToOrg (Table caption' _ _ headers rows) = do caption'' <- inlineListToOrg caption' let caption = if null caption' then empty - else (text "#+CAPTION: " <> caption'') + else ("#+CAPTION: " <> caption'') headers' <- mapM blockListToOrg headers rawRows <- mapM (mapM blockListToOrg) rows - let numChars = maximum . map (length . render) + let numChars = maximum . map offset -- FIXME: width is not being used. let widthsInChars = map ((+2) . numChars) $ transpose (headers' : rawRows) -- FIXME: Org doesn't allow blocks with height more than 1. - let hpipeBlocks blocks = hcatBlocks [beg, middle, end] - where height = maximum (map heightOfBlock blocks) - sep' = TextBlock 3 height (replicate height " | ") - beg = TextBlock 2 height (replicate height "| ") - end = TextBlock 2 height (replicate height " |") - middle = hcatBlocks $ intersperse sep' blocks - let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars + let hpipeBlocks blocks = hcat [beg, middle, end] + where h = maximum (map height blocks) + sep' = lblock 3 $ vcat (map text $ replicate h " | ") + beg = lblock 2 $ vcat (map text $ replicate h "| ") + end = lblock 2 $ vcat (map text $ replicate h " |") + middle = hcat $ intersperse sep' blocks + let makeRow = hpipeBlocks . zipWith lblock widthsInChars let head' = makeRow headers' rows' <- mapM (\row -> do cols <- mapM blockListToOrg row return $ makeRow cols) rows @@ -175,34 +165,37 @@ blockToOrg (Table caption' _ _ headers rows) = do (hcat $ intersperse (char ch <> char '+' <> char ch) $ map (\l -> text $ replicate l ch) widthsInChars) <> char ch <> char '|' - let body = vcat $ map blockToDoc rows' + let body = vcat rows' let head'' = if all null headers then empty - else blockToDoc head' $+$ border '-' - return $ head'' $+$ body $$ caption $$ text "" + else head' $$ border '-' + return $ head'' $$ body $$ caption $$ blankline blockToOrg (BulletList items) = do contents <- mapM bulletListItemToOrg items -- ensure that sublists have preceding blank line - return $ text "" $+$ vcat contents <> text "\n" -blockToOrg (OrderedList (start, style', delim) items) = do + return $ blankline $+$ vcat contents $$ blankline +blockToOrg (OrderedList (start, _, delim) items) = do + let delim' = case delim of + TwoParens -> OneParen + x -> x let markers = take (length items) $ orderedListMarkers - (start, style', delim) + (start, Decimal, delim') let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m in m ++ replicate s ' ') markers contents <- mapM (\(item, num) -> orderedListItemToOrg item num) $ - zip markers' items + zip markers' items -- ensure that sublists have preceding blank line - return $ text "" $+$ vcat contents <> text "\n" + return $ blankline $$ vcat contents $$ blankline blockToOrg (DefinitionList items) = do contents <- mapM definitionListItemToOrg items - return $ (vcat contents) <> text "\n" + return $ vcat contents $$ blankline -- | Convert bullet list item (list of blocks) to Org. bulletListItemToOrg :: [Block] -> State WriterState Doc bulletListItemToOrg items = do contents <- blockListToOrg items - return $ (text "- ") <> contents + return $ hang 3 "- " (contents <> cr) -- | Convert ordered list item (a list of blocks) to Org. orderedListItemToOrg :: String -- ^ marker for list item @@ -210,14 +203,14 @@ orderedListItemToOrg :: String -- ^ marker for list item -> State WriterState Doc orderedListItemToOrg marker items = do contents <- blockListToOrg items - return $ (text marker <> char ' ') <> contents + return $ hang (length marker + 1) (text marker <> space) (contents <> cr) -- | Convert defintion list item (label, list of blocks) to Org. definitionListItemToOrg :: ([Inline], [[Block]]) -> State WriterState Doc definitionListItemToOrg (label, defs) = do label' <- inlineListToOrg label contents <- liftM vcat $ mapM blockListToOrg defs - return $ (text "- ") <> label' <> (text " :: ") <> contents + return $ hang 3 "- " $ label' <> " :: " <> (contents <> cr) -- | Convert list of Pandoc block elements to Org. blockListToOrg :: [Block] -- ^ List of block elements @@ -232,60 +225,57 @@ inlineListToOrg lst = mapM inlineToOrg lst >>= return . hcat inlineToOrg :: Inline -> State WriterState Doc inlineToOrg (Emph lst) = do contents <- inlineListToOrg lst - return $ char '/' <> contents <> char '/' + return $ "/" <> contents <> "/" inlineToOrg (Strong lst) = do contents <- inlineListToOrg lst - return $ text "*" <> contents <> text "*" + return $ "*" <> contents <> "*" inlineToOrg (Strikeout lst) = do contents <- inlineListToOrg lst - return $ text "+" <> contents <> char '+' + return $ "+" <> contents <> "+" inlineToOrg (Superscript lst) = do contents <- inlineListToOrg lst - return $ text "^{" <> contents <> text "}" + return $ "^{" <> contents <> "}" inlineToOrg (Subscript lst) = do contents <- inlineListToOrg lst - return $ text "_{" <> contents <> text "}" + return $ "_{" <> contents <> "}" inlineToOrg (SmallCaps lst) = inlineListToOrg lst inlineToOrg (Quoted SingleQuote lst) = do contents <- inlineListToOrg lst - return $ char '\'' <> contents <> char '\'' + return $ "'" <> contents <> "'" inlineToOrg (Quoted DoubleQuote lst) = do contents <- inlineListToOrg lst - return $ char '\"' <> contents <> char '\"' -inlineToOrg (Cite _ lst) = - inlineListToOrg lst -inlineToOrg EmDash = return $ text "---" -inlineToOrg EnDash = return $ text "--" -inlineToOrg Apostrophe = return $ char '\'' -inlineToOrg Ellipses = return $ text "..." -inlineToOrg (Code str) = return $ text $ "=" ++ str ++ "=" + return $ "\"" <> contents <> "\"" +inlineToOrg (Cite _ lst) = inlineListToOrg lst +inlineToOrg EmDash = return "---" +inlineToOrg EnDash = return "--" +inlineToOrg Apostrophe = return "'" +inlineToOrg Ellipses = return "..." +inlineToOrg (Code str) = return $ "=" <> text str <> "=" inlineToOrg (Str str) = return $ text $ escapeString str inlineToOrg (Math t str) = do modify $ \st -> st{ stHasMath = True } return $ if t == InlineMath - then text $ "$" ++ str ++ "$" - else text $ "$$" ++ str ++ "$$" + then "$" <> text str <> "$" + else "$$" <> text str <> "$$" inlineToOrg (TeX str) = return $ text str inlineToOrg (HtmlInline _) = return empty -inlineToOrg (LineBreak) = do - return $ empty -- there's no line break in Org -inlineToOrg Space = return $ char ' ' +inlineToOrg (LineBreak) = return cr -- there's no line break in Org +inlineToOrg Space = return space inlineToOrg (Link txt (src, _)) = do case txt of [Code x] | x == src -> -- autolink do modify $ \s -> s{ stLinks = True } - return $ text $ "[[" ++ x ++ "]]" + return $ "[[" <> text x <> "]]" _ -> do contents <- inlineListToOrg txt modify $ \s -> s{ stLinks = True } - return $ text ("[[" ++ src ++ "][") <> contents <> - (text "]]") + return $ "[[" <> text src <> "][" <> contents <> "]]" inlineToOrg (Image _ (source', _)) = do let source = unescapeURI source' modify $ \s -> s{ stImages = True } - return $ text $ "[[" ++ source ++ "]]" + return $ "[[" <> text source <> "]]" inlineToOrg (Note contents) = do -- add to notes in state notes <- get >>= (return . stNotes) modify $ \st -> st { stNotes = contents:notes } let ref = show $ (length notes) + 1 - return $ text " [" <> text ref <> text "]" + return $ " [" <> text ref <> "]" |