@@ -284,7 +284,7 @@ block = choice [ mempty <$ blanklines
284284 , orgBlock
285285 , figure
286286 , example
287− , drawer
287+ , genericDrawer
288288 , specialLine
289289 , header
290290 , return <$> hline
@@ -582,26 +582,55 @@ exampleCode = B.codeBlockWith ("", ["example"], [])
582582exampleLine :: OrgParser String
583583exampleLine = try $ skipSpaces *> string ": " *> anyLine
584584
585−-- Drawers for properties or a logbook
586−drawer :: OrgParser (F Blocks)
587−drawer = try $ do
585+
586+--
587+-- Drawers
588+--
589+
590+-- | A generic drawer which has no special meaning for org-mode.
591+genericDrawer :: OrgParser (F Blocks)
592+genericDrawer = try $ do
588593 drawerStart
589594 manyTill drawerLine (try drawerEnd)
590595 return mempty
591596
592597drawerStart :: OrgParser String
593598drawerStart = try $
594− skipSpaces *> drawerName <* skipSpaces <* P.newline
595− where drawerName = try $ char ':' *> validDrawerName <* char ':'
596− validDrawerName = stringAnyCase "PROPERTIES"
597− <|> stringAnyCase "LOGBOOK"
599+ skipSpaces *> drawerName <* skipSpaces <* newline
600+ where drawerName = char ':' *> manyTill nonspaceChar (char ':')
598601
599602drawerLine :: OrgParser String
600−drawerLine = try anyLine
603+drawerLine = anyLine
601604
602605drawerEnd :: OrgParser String
603606drawerEnd = try $
604− skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* P.newline
607+ skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
608+
609+-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
610+-- within.
611+propertiesDrawer :: OrgParser [(String, String)]
612+propertiesDrawer = try $ do
613+ drawerType <- drawerStart
614+ guard $ map toUpper drawerType == "PROPERTIES"
615+ manyTill property (try drawerEnd)
616+ where
617+ property :: OrgParser (String, String)
618+ property = try $ (,) <$> key <*> value
619+
620+ key :: OrgParser String
621+ key = try $ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
622+
623+ value :: OrgParser String
624+ value = try $ skipSpaces *> manyTill anyChar (try $ skipSpaces *> P.newline)
625+
626+keyValuesToAttr :: [(String, String)] -> Attr
627+keyValuesToAttr kvs =
628+ let
629+ id' = fromMaybe mempty . lookup "id" $ kvs
630+ cls = fromMaybe mempty . lookup "class" $ kvs
631+ kvs' = filter (flip notElem ["id", "class"] . fst) kvs
632+ in
633+ (id', words cls, kvs')
605634
606635
607636--
@@ -700,29 +729,28 @@ parseFormat = try $ do
700729-- | Headers
701730header :: OrgParser (F Blocks)
702731header = try $ do
703− level <- headerStart
704− title <- manyTill inline (lookAhead headerEnd)
705− tags <- headerEnd
706− let inlns = trimInlinesF . mconcat $ title <> map tagToInlineF tags
707− st <- getState
708− let inlines = runF inlns st
709− attr <- registerHeader nullAttr inlines
732+ level <- headerStart
733+ title <- manyTill inline (lookAhead $ optional headerTags <* P.newline)
734+ tags <- option [] headerTags
735+ newline
736+ propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)
737+ inlines <- runF (tagTitle title tags) <$> getState
738+ attr <- registerHeader propAttr inlines
710739 return $ pure (B.headerWith attr level inlines)
711740 where
741+ tagTitle :: [F Inlines] -> [String] -> F Inlines
742+ tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags
743+
712744 tagToInlineF :: String -> F Inlines
713745 tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
714746
715−headerEnd :: OrgParser [String]
716−headerEnd = option [] headerTags <* newline
717−
718−headerTags :: OrgParser [String]
719−headerTags = try $
720− skipSpaces
721− *> char ':'
722− *> many1 tag
723− <* skipSpaces
724− where tag = many1 (alphaNum <|> oneOf "@%#_")
725− <* char ':'
747+ headerTags :: OrgParser [String]
748+ headerTags = try $
749+ let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
750+ in skipSpaces
751+ *> char ':'
752+ *> many1 tag
753+ <* skipSpaces
726754
727755headerStart :: OrgParser Int
728756headerStart = try $