@@ -43,7 +43,7 @@ import Text.Pandoc.Shared (compactify', compactify'DL)
4343
4444import Control.Applicative ( Applicative, pure
4545 , (<$>), (<$), (<*>), (<*), (*>), (<**>) )
46−import Control.Monad (foldM, guard, liftM, liftM2, when)
46+import Control.Monad (foldM, guard, liftM, liftM2, mzero, when)
4747import Control.Monad.Reader (Reader, runReader, ask, asks)
4848import Data.Char (isAlphaNum, toLower)
4949import Data.Default
@@ -51,6 +51,7 @@ import Data.List (intersperse, isPrefixOf, isSuffixOf)
5151import qualified Data.Map as M
5252import Data.Maybe (listToMaybe, fromMaybe, isJust)
5353import Data.Monoid (Monoid, mconcat, mempty, mappend)
54+import Network.HTTP (urlEncode)
5455
5556-- | Parse org-mode string and return a Pandoc document.
5657readOrg :: ReaderOptions -- ^ Reader options
@@ -76,6 +77,8 @@ type OrgNoteTable = [OrgNoteRecord]
7677
7778type OrgBlockAttributes = M.Map String String
7879
80+type OrgLinkFormatters = M.Map String (String -> String)
81+
7982-- | Org-mode parser state
8083data OrgParserState = OrgParserState
8184 { orgStateOptions :: ReaderOptions
@@ -86,6 +89,7 @@ data OrgParserState = OrgParserState
8689 , orgStateLastForbiddenCharPos :: Maybe SourcePos
8790 , orgStateLastPreCharPos :: Maybe SourcePos
8891 , orgStateLastStrPos :: Maybe SourcePos
92+ , orgStateLinkFormatters :: OrgLinkFormatters
8993 , orgStateMeta :: Meta
9094 , orgStateMeta' :: F Meta
9195 , orgStateNotes' :: OrgNoteTable
@@ -113,6 +117,7 @@ defaultOrgParserState = OrgParserState
113117 , orgStateLastForbiddenCharPos = Nothing
114118 , orgStateLastPreCharPos = Nothing
115119 , orgStateLastStrPos = Nothing
120+ , orgStateLinkFormatters = M.empty
116121 , orgStateMeta = nullMeta
117122 , orgStateMeta' = return nullMeta
118123 , orgStateNotes' = []
@@ -175,6 +180,13 @@ resetEmphasisNewlines :: OrgParser ()
175180resetEmphasisNewlines = updateState $ \s ->
176181 s{ orgStateEmphasisNewlines = Nothing }
177182
183+addLinkFormat :: String
184+ -> (String -> String)
185+ -> OrgParser ()
186+addLinkFormat key formatter = updateState $ \s ->
187+ let fs = orgStateLinkFormatters s
188+ in s{ orgStateLinkFormatters = M.insert key formatter fs }
189+
178190addToNotesTable :: OrgNoteRecord -> OrgParser ()
179191addToNotesTable note = do
180192 oldnotes <- orgStateNotes' <$> getState
@@ -423,7 +435,8 @@ specialLine :: OrgParser (F Blocks)
423435specialLine = fmap return . try $ metaLine <|> commentLine
424436
425437metaLine :: OrgParser Blocks
426−metaLine = try $ metaLineStart *> declarationLine
438+metaLine = try $ mempty
439+ <$ (metaLineStart *> (optionLine <|> declarationLine))
427440
428441commentLine :: OrgParser Blocks
429442commentLine = try $ commentLineStart *> anyLine *> pure mempty
@@ -436,14 +449,14 @@ metaLineStart = try $ mappend <$> many spaceChar <*> string "#+"
436449commentLineStart :: OrgParser String
437450commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
438451
439−declarationLine :: OrgParser Blocks
452+declarationLine :: OrgParser ()
440453declarationLine = try $ do
441454 key <- metaKey
442455 inlinesF <- metaInlines
443456 updateState $ \st ->
444457 let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta
445458 in st { orgStateMeta' = orgStateMeta' st <> meta' }
446− return mempty
459+ return ()
447460
448461metaInlines :: OrgParser (F MetaValue)
449462metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
@@ -453,6 +466,35 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")
453466 <* char ':'
454467 <* skipSpaces
455468
469+optionLine :: OrgParser ()
470+optionLine = try $ do
471+ key <- metaKey
472+ case key of
473+ "link" -> parseLinkFormat >>= uncurry addLinkFormat
474+ _ -> mzero
475+
476+parseLinkFormat :: OrgParser ((String, String -> String))
477+parseLinkFormat = try $ do
478+ linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
479+ linkSubst <- parseFormat
480+ return (linkType, linkSubst)
481+
482+-- | An ad-hoc, single-argument-only implementation of a printf-style format
483+-- parser.
484+parseFormat :: OrgParser (String -> String)
485+parseFormat = try $ do
486+ replacePlain <|> replaceUrl <|> justAppend
487+ where
488+ -- inefficient, but who cares
489+ replacePlain = try $ (\x -> concat . flip intersperse x)
490+ <$> sequence [tillSpecifier 's', rest]
491+ replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
492+ <$> sequence [tillSpecifier 'h', rest]
493+ justAppend = try $ (++) <$> rest
494+
495+ rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
496+ tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
497+
456498--
457499-- Headers
458500--
@@ -850,13 +892,15 @@ linkOrImage = explicitOrImageLink
850892explicitOrImageLink :: OrgParser (F Inlines)
851893explicitOrImageLink = try $ do
852894 char '['
853− src <- linkTarget
895+ srcF <- applyCustomLinkFormat =<< linkTarget
854896 title <- enclosedRaw (char '[') (char ']')
855897 title' <- parseFromString (mconcat <$> many inline) title
856898 char ']'
857− return $ if isImageFilename src && isImageFilename title
858− then pure $ B.link src "" $ B.image title mempty mempty
859− else linkToInlinesF src =<< title'
899+ return $ do
900+ src <- srcF
901+ if isImageFilename src && isImageFilename title
902+ then pure $ B.link src "" $ B.image title mempty mempty
903+ else linkToInlinesF src =<< title'
860904
861905selflinkOrImage :: OrgParser (F Inlines)
862906selflinkOrImage = try $ do
@@ -881,6 +925,14 @@ selfTarget = try $ char '[' *> linkTarget <* char ']'
881925linkTarget :: OrgParser String
882926linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")
883927
928+applyCustomLinkFormat :: String -> OrgParser (F String)
929+applyCustomLinkFormat link = do
930+ let (linkType, rest) = break (== ':') link
931+ return $ do
932+ formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters
933+ return $ maybe link ($ drop 1 rest) formatter
934+
935+
884936linkToInlinesF :: String -> Inlines -> F Inlines
885937linkToInlinesF s@('#':_) = pure . B.link s ""
886938linkToInlinesF s