@@ -138,7 +138,7 @@ exportSetting = choice
138138 , ignoredSetting "author"
139139 , ignoredSetting "c"
140140 , ignoredSetting "creator"
141− , ignoredSetting "d"
141+ , complementableListSetting "d" setExportDrawers
142142 , ignoredSetting "date"
143143 , ignoredSetting "e"
144144 , ignoredSetting "email"
@@ -164,15 +164,53 @@ booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()
164164booleanSetting settingIdentifier setter = try $ do
165165 string settingIdentifier
166166 char ':'
167− value <- many nonspaceChar
168− let boolValue = case value of
169− "nil" -> False
170− "{}" -> False
171− _ -> True
172− updateState $ modifyExportSettings setter boolValue
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
174+ value <- many1 nonspaceChar
175+ return $ case map toLower value of
176+ "nil" -> False
177+ "{}" -> False
178+ "()" -> False
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+ ]
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 '"')
173211
174212ignoredSetting :: String -> OrgParser ()
175−ignoredSetting s = try (() <$ string s <* char ':' <* many nonspaceChar)
213+ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
176214
177215--
178216-- Parser
@@ -588,11 +626,27 @@ exampleLine = try $ skipSpaces *> string ": " *> anyLine
588626--
589627
590628-- | 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.
591631genericDrawer :: OrgParser (F Blocks)
592632genericDrawer = try $ do
593− drawerStart
594− manyTill drawerLine (try drawerEnd)
595− return mempty
633+ name <- map toUpper <$> drawerStart
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
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)
596650
597651drawerStart :: OrgParser String
598652drawerStart = try $
@@ -626,9 +680,10 @@ propertiesDrawer = try $ do
626680keyValuesToAttr :: [(String, String)] -> Attr
627681keyValuesToAttr kvs =
628682 let
629− id' = fromMaybe mempty . lookup "id" $ kvs
630− cls = fromMaybe mempty . lookup "class" $ kvs
631− kvs' = filter (flip notElem ["id", "class"] . fst) kvs
683+ lowerKvs = map (\(k, v) -> (map toLower k, v)) kvs
684+ id' = fromMaybe mempty . lookup "custom_id" $ lowerKvs
685+ cls = fromMaybe mempty . lookup "class" $ lowerKvs
686+ kvs' = filter (flip notElem ["custom_id", "class"] . fst) lowerKvs
632687 in
633688 (id', words cls, kvs')
634689