654bdf7 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #2941 from tarleb/org-drawer-improvements

654bdf7John MacFarlane10 years ago

src/Text/Pandoc/Readers/Org.hs+69−14

compare with master

unifiedsplit

@@ -138,7 +138,7 @@ exportSetting = choice

138 , ignoredSetting "author"

139 , ignoredSetting "c"

140 , ignoredSetting "creator"

141− , ignoredSetting "d"

141+ , complementableListSetting "d" setExportDrawers

142 , ignoredSetting "date"

143 , ignoredSetting "e"

144 , ignoredSetting "email"

@@ -164,15 +164,53 @@ booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()

164booleanSetting settingIdentifier setter = try $ do

165 string settingIdentifier

166 char ':'

167+ value <- elispBoolean

168+ updateState $ modifyExportSettings setter value

169+

170+-- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are

171+-- interpreted as true.

172+elispBoolean :: OrgParser Bool

173+elispBoolean = try $ do

167− value <- many nonspaceChar

174+ value <- many1 nonspaceChar

168− let boolValue = case value of

175+ return $ case map toLower value of

169− "nil" -> False

176+ "nil" -> False

170− "{}" -> False

177+ "{}" -> False

178+ "()" -> False

171− _ -> True

179+ _ -> True

180+

181+-- | A list or a complement list (i.e. a list starting with `not`).

182+complementableListSetting :: String

183+ -> ExportSettingSetter (Either [String] [String])

184+ -> OrgParser ()

185+complementableListSetting settingIdentifier setter = try $ do

186+ _ <- string settingIdentifier <* char ':'

187+ value <- choice [ Left <$> complementStringList

188+ , Right <$> stringList

189+ , (\b -> if b then Left [] else Right []) <$> elispBoolean

190+ ]

172− updateState $ modifyExportSettings setter boolValue

191+ updateState $ modifyExportSettings setter value

192+ where

193+ -- Read a plain list of strings.

194+ stringList :: OrgParser [String]

195+ stringList = try $

196+ char '('

197+ *> sepBy elispString spaces

198+ <* char ')'

199+

200+ -- Read an emacs lisp list specifying a complement set.

201+ complementStringList :: OrgParser [String]

202+ complementStringList = try $

203+ string "(not "

204+ *> sepBy elispString spaces

205+ <* char ')'

206+

207+ elispString :: OrgParser String

208+ elispString = try $

209+ char '"'

210+ *> manyTill alphaNum (char '"')

173

211

174ignoredSetting :: String -> OrgParser ()

212ignoredSetting :: String -> OrgParser ()

175−ignoredSetting s = try (() <$ string s <* char ':' <* many nonspaceChar)

213+ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)

176

214

177--

215--

178-- Parser

216-- Parser

@@ -588,11 +626,27 @@ exampleLine = try $ skipSpaces *> string ": " *> anyLine

588--

626--

589

627

590-- | A generic drawer which has no special meaning for org-mode.

628-- | A generic drawer which has no special meaning for org-mode.

629+-- Whether or not this drawer is included in the output depends on the drawers

630+-- export setting.

591genericDrawer :: OrgParser (F Blocks)

631genericDrawer :: OrgParser (F Blocks)

592genericDrawer = try $ do

632genericDrawer = try $ do

593− drawerStart

633+ name <- map toUpper <$> drawerStart

594− manyTill drawerLine (try drawerEnd)

634+ content <- manyTill drawerLine (try drawerEnd)

635+ state <- getState

636+ -- Include drawer if it is explicitly included in or not explicitly excluded

637+ -- from the list of drawers that should be exported. PROPERTIES drawers are

638+ -- never exported.

639+ case (exportDrawers . orgStateExportSettings $ state) of

640+ _ | name == "PROPERTIES" -> return mempty

641+ Left names | name `elem` names -> return mempty

595− return mempty

642+ Right names | name `notElem` names -> return mempty

643+ _ -> drawerDiv name <$> parseLines content

644+ where

645+ parseLines :: [String] -> OrgParser (F Blocks)

646+ parseLines = parseFromString parseBlocks . (++ "\n") . unlines

647+

648+ drawerDiv :: String -> F Blocks -> F Blocks

649+ drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)

596

650

597drawerStart :: OrgParser String

651drawerStart :: OrgParser String

598drawerStart = try $

652drawerStart = try $

@@ -626,9 +680,10 @@ propertiesDrawer = try $ do

626keyValuesToAttr :: [(String, String)] -> Attr

680keyValuesToAttr :: [(String, String)] -> Attr

627keyValuesToAttr kvs =

681keyValuesToAttr kvs =

628 let

682 let

683+ lowerKvs = map (\(k, v) -> (map toLower k, v)) kvs

629− id' = fromMaybe mempty . lookup "id" $ kvs

684+ id' = fromMaybe mempty . lookup "custom_id" $ lowerKvs

630− cls = fromMaybe mempty . lookup "class" $ kvs

685+ cls = fromMaybe mempty . lookup "class" $ lowerKvs

631− kvs' = filter (flip notElem ["id", "class"] . fst) kvs

686+ kvs' = filter (flip notElem ["custom_id", "class"] . fst) lowerKvs

632 in

687 in

633 (id', words cls, kvs')

688 (id', words cls, kvs')

634

689

src/Text/Pandoc/Readers/Org/ParserState.hs+14−1

@@ -39,8 +39,9 @@ module Text.Pandoc.Readers.Org.ParserState

39 , runF

40 , returnF

41 , ExportSettingSetter

42− , exportSubSuperscripts

42+ , ExportSettings (..)

43 , setExportSubSuperscripts

44+ , setExportDrawers

44 , modifyExportSettings

45 , modifyExportSettings

45 ) where

46 ) where

@@ -76,6 +77,10 @@ type OrgLinkFormatters = M.Map String (String -> String)

76-- These settings can be changed via OPTIONS statements.

77-- These settings can be changed via OPTIONS statements.

77data ExportSettings = ExportSettings

78data ExportSettings = ExportSettings

78 { exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts

79 { exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts

80+ , exportDrawers :: Either [String] [String]

81+ -- ^ Specify drawer names which should be exported. @Left@ names are

82+ -- explicitly excluded from the resulting output while @Right@ means that

83+ -- only the listed drawer names should be included.

79 }

84 }

81-- | Org-mode parser state

86-- | Org-mode parser state

@@ -155,6 +160,7 @@ defaultOrgParserState = OrgParserState

155defaultExportSettings :: ExportSettings

160defaultExportSettings :: ExportSettings

156defaultExportSettings = ExportSettings

161defaultExportSettings = ExportSettings

157 { exportSubSuperscripts = True

162 { exportSubSuperscripts = True

163+ , exportDrawers = Left ["LOGBOOK"]

158 }

164 }

159

165

160

166

@@ -163,9 +169,16 @@ defaultExportSettings = ExportSettings

163--

169--

164type ExportSettingSetter a = a -> ExportSettings -> ExportSettings

170type ExportSettingSetter a = a -> ExportSettings -> ExportSettings

165

171

172+-- | Set export options for sub/superscript parsing. The short syntax will

173+-- not be parsed if this is set set to @False@.

166setExportSubSuperscripts :: ExportSettingSetter Bool

174setExportSubSuperscripts :: ExportSettingSetter Bool

167setExportSubSuperscripts val es = es { exportSubSuperscripts = val }

175setExportSubSuperscripts val es = es { exportSubSuperscripts = val }

168

176

177+-- | Set export options for drawers. See the @exportDrawers@ in ADT

178+-- @ExportSettings@ for details.

179+setExportDrawers :: ExportSettingSetter (Either [String] [String])

180+setExportDrawers val es = es { exportDrawers = val }

181+

169-- | Modify a parser state

182-- | Modify a parser state

170modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState

183modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState

171modifyExportSettings setter val state =

184modifyExportSettings setter val state =

src/Text/Pandoc/Writers/Org.hs+13−2

@@ -110,6 +110,17 @@ isRawFormat f =

110blockToOrg :: Block -- ^ Block element

111 -> State WriterState Doc

112blockToOrg Null = return empty

113+blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do

114+ contents <- blockListToOrg bs

115+ let drawerNameTag = ":" <> text cls <> ":"

116+ let keys = vcat $ map (\(k,v) ->

117+ ":" <> text k <> ":"

118+ <> space <> text v) kvs

119+ let drawerEndTag = text ":END:"

120+ return $ drawerNameTag $$ cr $$ keys $$

121+ blankline $$ contents $$

122+ blankline $$ drawerEndTag $$

123+ blankline

113blockToOrg (Div attrs bs) = do

124blockToOrg (Div attrs bs) = do

114 contents <- blockListToOrg bs

125 contents <- blockListToOrg bs

115 let startTag = tagWithAttrs "div" attrs

126 let startTag = tagWithAttrs "div" attrs

@@ -239,8 +250,8 @@ propertiesDrawer (ident, classes, kv) =

239 let

250 let

240 drawerStart = text ":PROPERTIES:"

251 drawerStart = text ":PROPERTIES:"

241 drawerEnd = text ":END:"

252 drawerEnd = text ":END:"

242− kv' = if (classes == mempty) then kv else ("class", unwords classes):kv

253+ kv' = if (classes == mempty) then kv else ("CLASS", unwords classes):kv

243− kv'' = if (ident == mempty) then kv' else ("id", ident):kv'

254+ kv'' = if (ident == mempty) then kv' else ("CUSTOM_ID", ident):kv'

244 properties = vcat $ map kvToOrgProperty kv''

255 properties = vcat $ map kvToOrgProperty kv''

245 in

256 in

246 drawerStart <> cr <> properties <> cr <> drawerEnd

257 drawerStart <> cr <> properties <> cr <> drawerEnd

tests/Tests/Readers/Org.hs+25−2

@@ -420,9 +420,10 @@ tests =

420

421 , "Drawers can be arbitrary" =:

422 unlines [ ":FOO:"

423+ , "/bar/"

423 , ":END:"

424 , ":END:"

424 ] =?>

425 ] =?>

425− (mempty::Blocks)

426+ divWith (mempty, ["FOO", "drawer"], mempty) (para $ emph "bar")

426

427

427 , "Anchor reference" =:

428 , "Anchor reference" =:

428 unlines [ "<<link-here>> Target."

429 unlines [ "<<link-here>> Target."

@@ -475,6 +476,28 @@ tests =

475 , "a^b"

476 , "a^b"

476 ] =?>

477 ] =?>

477 para "a^b"

478 para "a^b"

479+

480+ , "Export option: directly select drawers to be exported" =:

481+ unlines [ "#+OPTIONS: d:(\"IMPORTANT\")"

482+ , ":IMPORTANT:"

483+ , "23"

484+ , ":END:"

485+ , ":BORING:"

486+ , "very boring"

487+ , ":END:"

488+ ] =?>

489+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23")

490+

491+ , "Export option: exclude drawers from being exported" =:

492+ unlines [ "#+OPTIONS: d:(not \"BORING\")"

493+ , ":IMPORTANT:"

494+ , "5"

495+ , ":END:"

496+ , ":BORING:"

497+ , "very boring"

498+ , ":END:"

499+ ] =?>

500+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5")

478 ]

501 ]

479

502

480 , testGroup "Basic Blocks" $

503 , testGroup "Basic Blocks" $

@@ -600,7 +623,7 @@ tests =

600 , "Preferences are treated as header attributes" =:

623 , "Preferences are treated as header attributes" =:

601 unlines [ "* foo"

624 unlines [ "* foo"

602 , " :PROPERTIES:"

625 , " :PROPERTIES:"

603− , " :id: fubar"

626+ , " :custom_id: fubar"

604 , " :bar: baz"

627 , " :bar: baz"

605 , " :END:"

628 , " :END:"

606 ] =?>

629 ] =?>

tests/writer.org+31−31

@@ -10,49 +10,49 @@ markdown test suite.

11* Headers

12 :PROPERTIES:

13− :id: headers

13+ :CUSTOM_ID: headers

14 :END:

16** Level 2 with an [[/url][embedded link]]

17 :PROPERTIES:

18− :id: level-2-with-an-embedded-link

18+ :CUSTOM_ID: level-2-with-an-embedded-link

19 :END:

21*** Level 3 with /emphasis/

22 :PROPERTIES:

23− :id: level-3-with-emphasis

23+ :CUSTOM_ID: level-3-with-emphasis

24 :END:

26**** Level 4

27 :PROPERTIES:

28− :id: level-4

28+ :CUSTOM_ID: level-4

29 :END:

31***** Level 5

32 :PROPERTIES:

33− :id: level-5

33+ :CUSTOM_ID: level-5

34 :END:

36* Level 1

37 :PROPERTIES:

38− :id: level-1

38+ :CUSTOM_ID: level-1

39 :END:

41** Level 2 with /emphasis/

42 :PROPERTIES:

43− :id: level-2-with-emphasis

43+ :CUSTOM_ID: level-2-with-emphasis

44 :END:

46*** Level 3

47 :PROPERTIES:

48− :id: level-3

48+ :CUSTOM_ID: level-3

49 :END:

51with no blank line

53** Level 2

54 :PROPERTIES:

55− :id: level-2

55+ :CUSTOM_ID: level-2

56 :END:

58with no blank line

@@ -61,7 +61,7 @@ with no blank line

62* Paragraphs

63 :PROPERTIES:

64− :id: paragraphs

64+ :CUSTOM_ID: paragraphs

65 :END:

67Here's a regular paragraph.

@@ -79,7 +79,7 @@ here.

80* Block Quotes

81 :PROPERTIES:

82− :id: block-quotes

82+ :CUSTOM_ID: block-quotes

83 :END:

85E-mail style:

@@ -121,7 +121,7 @@ And a following paragraph.

121

122* Code Blocks

123 :PROPERTIES:

124− :id: code-blocks

124+ :CUSTOM_ID: code-blocks

125 :END:

126

127Code:

@@ -148,12 +148,12 @@ And:

148

149* Lists

150 :PROPERTIES:

151− :id: lists

151+ :CUSTOM_ID: lists

152 :END:

153

154** Unordered

155 :PROPERTIES:

156− :id: unordered

156+ :CUSTOM_ID: unordered

157 :END:

158

159Asterisks tight:

@@ -200,7 +200,7 @@ Minuses loose:

200

201** Ordered

202 :PROPERTIES:

203− :id: ordered

203+ :CUSTOM_ID: ordered

204 :END:

205

206Tight:

@@ -243,7 +243,7 @@ Multiple paragraphs:

243

244** Nested

245 :PROPERTIES:

246− :id: nested

246+ :CUSTOM_ID: nested

247 :END:

248

249- Tab

@@ -277,7 +277,7 @@ Same thing but with paragraphs:

277

278** Tabs and spaces

279 :PROPERTIES:

280− :id: tabs-and-spaces

280+ :CUSTOM_ID: tabs-and-spaces

281 :END:

282

283- this is a list item indented with tabs

@@ -290,7 +290,7 @@ Same thing but with paragraphs:

290

291** Fancy list markers

292 :PROPERTIES:

293− :id: fancy-list-markers

293+ :CUSTOM_ID: fancy-list-markers

294 :END:

295

2962) begins with 2

@@ -331,7 +331,7 @@ B. Williams

331

332* Definition Lists

333 :PROPERTIES:

334− :id: definition-lists

334+ :CUSTOM_ID: definition-lists

335 :END:

336

337Tight using spaces:

@@ -400,7 +400,7 @@ Blank line after term, indented marker, alternate markers:

400

401* HTML Blocks

402 :PROPERTIES:

403− :id: html-blocks

403+ :CUSTOM_ID: html-blocks

404 :END:

405

406Simple block on one line:

@@ -630,7 +630,7 @@ Hr's:

630

631* Inline Markup

632 :PROPERTIES:

633− :id: inline-markup

633+ :CUSTOM_ID: inline-markup

634 :END:

635

636This is /emphasized/, and so /is this/.

@@ -662,7 +662,7 @@ spaces: a\^b c\^d, a~b c~d.

662

663* Smart quotes, ellipses, dashes

664 :PROPERTIES:

665− :id: smart-quotes-ellipses-dashes

665+ :CUSTOM_ID: smart-quotes-ellipses-dashes

666 :END:

667

668"Hello," said the spider. "'Shelob' is my name."

@@ -686,7 +686,7 @@ Ellipses...and...and....

686

687* LaTeX

688 :PROPERTIES:

689− :id: latex

689+ :CUSTOM_ID: latex

690 :END:

691

692- \cite[22-23]{smith.1899}

@@ -719,7 +719,7 @@ Cat & 1 \\ \hline

719

720* Special Characters

721 :PROPERTIES:

722− :id: special-characters

722+ :CUSTOM_ID: special-characters

723 :END:

724

725Here is some unicode:

@@ -776,12 +776,12 @@ Minus: -

776

777* Links

778 :PROPERTIES:

779− :id: links

779+ :CUSTOM_ID: links

780 :END:

781

782** Explicit

783 :PROPERTIES:

784− :id: explicit

784+ :CUSTOM_ID: explicit

785 :END:

786

787Just a [[/url/][URL]].

@@ -804,7 +804,7 @@ Just a [[/url/][URL]].

804

805** Reference

806 :PROPERTIES:

807− :id: reference

807+ :CUSTOM_ID: reference

808 :END:

809

810Foo [[/url/][bar]].

@@ -835,7 +835,7 @@ Foo [[/url/][biz]].

835

836** With ampersands

837 :PROPERTIES:

838− :id: with-ampersands

838+ :CUSTOM_ID: with-ampersands

839 :END:

840

841Here's a [[http://example.com/?foo=1&bar=2][link with an ampersand in the

@@ -849,7 +849,7 @@ Here's an [[/script?foo=1&bar=2][inline link in pointy braces]].

849

850** Autolinks

851 :PROPERTIES:

852− :id: autolinks

852+ :CUSTOM_ID: autolinks

853 :END:

854

855With an ampersand: [[http://example.com/?foo=1&bar=2]]

@@ -874,7 +874,7 @@ Auto-links should not occur here: =<http://example.com/>=

874

875* Images

876 :PROPERTIES:

877− :id: images

877+ :CUSTOM_ID: images

878 :END:

879

880From "Voyage dans la Lune" by Georges Melies (1902):

@@ -888,7 +888,7 @@ Here is a movie [[movie.jpg]] icon.

888

889* Footnotes

890 :PROPERTIES:

891− :id: footnotes

891+ :CUSTOM_ID: footnotes

892 :END:

893

894Here is a footnote reference, [1] and another. [2] This should /not/ be a