@@ -45,7 +45,7 @@ import Control.Applicative ( Applicative, pure
4545 , (<$>), (<$), (<*>), (<*), (*>), (<**>) )
4646import Control.Monad (foldM, guard, liftM, liftM2, when)
4747import Control.Monad.Reader (Reader, runReader, ask, asks)
48−import Data.Char (toLower)
48+import Data.Char (isAlphaNum, toLower)
4949import Data.Default
5050import Data.List (intersperse, isPrefixOf, isSuffixOf)
5151import qualified Data.Map as M
@@ -79,6 +79,7 @@ type OrgBlockAttributes = M.Map String String
7979-- | Org-mode parser state
8080data OrgParserState = OrgParserState
8181 { orgStateOptions :: ReaderOptions
82+ , orgStateAnchorIds :: [String]
8283 , orgStateBlockAttributes :: OrgBlockAttributes
8384 , orgStateEmphasisCharStack :: [Char]
8485 , orgStateEmphasisNewlines :: Maybe Int
@@ -105,6 +106,7 @@ instance Default OrgParserState where
105106defaultOrgParserState :: OrgParserState
106107defaultOrgParserState = OrgParserState
107108 { orgStateOptions = def
109+ , orgStateAnchorIds = []
108110 , orgStateBlockAttributes = M.empty
109111 , orgStateEmphasisCharStack = []
110112 , orgStateEmphasisNewlines = Nothing
@@ -116,6 +118,10 @@ defaultOrgParserState = OrgParserState
116118 , orgStateNotes' = []
117119 }
118120
121+recordAnchorId :: String -> OrgParser ()
122+recordAnchorId i = updateState $ \s ->
123+ s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }
124+
119125addBlockAttribute :: String -> String -> OrgParser ()
120126addBlockAttribute key val = updateState $ \s ->
121127 let attrs = orgStateBlockAttributes s
@@ -209,6 +215,9 @@ instance Monoid a => Monoid (F a) where
209215trimInlinesF :: F Inlines -> F Inlines
210216trimInlinesF = liftM trimInlines
211217
218+returnF :: a -> OrgParser (F a)
219+returnF = return . return
220+
212221
213222-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
214223newline :: OrgParser Char
@@ -291,9 +300,6 @@ orgBlock = try $ do
291300 "src" -> codeBlockWithAttr classArgs content
292301 _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks
293302 where
294− returnF :: a -> OrgParser (F a)
295− returnF = return . return
296−
297303 parseVerse :: String -> OrgParser (F Blocks)
298304 parseVerse cs =
299305 fmap B.para . mconcat . intersperse (pure B.linebreak)
@@ -740,6 +746,7 @@ inline =
740746 , linebreak
741747 , footnote
742748 , linkOrImage
749+ , anchor
743750 , str
744751 , endline
745752 , emph
@@ -834,7 +841,11 @@ noteMarker = try $ do
834841 ]
835842
836843linkOrImage :: OrgParser (F Inlines)
837−linkOrImage = explicitOrImageLink <|> selflinkOrImage <?> "link or image"
844+linkOrImage = explicitOrImageLink
845+ <|> selflinkOrImage
846+ <|> angleLink
847+ <|> plainLink
848+ <?> "link or image"
838849
839850explicitOrImageLink :: OrgParser (F Inlines)
840851explicitOrImageLink = try $ do
@@ -843,23 +854,52 @@ explicitOrImageLink = try $ do
843854 title <- enclosedRaw (char '[') (char ']')
844855 title' <- parseFromString (mconcat <$> many inline) title
845856 char ']'
846− return $ B.link src "" <$>
847− if isImageFilename src && isImageFilename title
848− then return $ B.image title mempty mempty
849− else title'
857+ return $ if isImageFilename src && isImageFilename title
858+ then pure $ B.link src "" $ B.image title mempty mempty
859+ else linkToInlinesF src =<< title'
850860
851861selflinkOrImage :: OrgParser (F Inlines)
852862selflinkOrImage = try $ do
853863 src <- char '[' *> linkTarget <* char ']'
854− return . return $ if isImageFilename src
855− then B.image src "" ""
856− else B.link src "" (B.str src)
864+ return $ linkToInlinesF src (B.str src)
865+
866+plainLink :: OrgParser (F Inlines)
867+plainLink = try $ do
868+ (orig, src) <- uri
869+ returnF $ B.link src "" (B.str orig)
870+
871+angleLink :: OrgParser (F Inlines)
872+angleLink = try $ do
873+ char '<'
874+ link <- plainLink
875+ char '>'
876+ return link
857877
858878selfTarget :: OrgParser String
859879selfTarget = try $ char '[' *> linkTarget <* char ']'
860880
861881linkTarget :: OrgParser String
862−linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")
882+linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")
883+
884+linkToInlinesF :: String -> Inlines -> F Inlines
885+linkToInlinesF s@('#':_) = pure . B.link s ""
886+linkToInlinesF s
887+ | isImageFilename s = const . pure $ B.image s "" ""
888+ | isUri s = pure . B.link s ""
889+ | isRelativeUrl s = pure . B.link s ""
890+linkToInlinesF s = \title -> do
891+ anchorB <- (s `elem`) <$> asksF orgStateAnchorIds
892+ if anchorB
893+ then pure $ B.link ('#':s) "" title
894+ else pure $ B.emph title
895+
896+isRelativeUrl :: String -> Bool
897+isRelativeUrl s = (':' `notElem` s) && ("./" `isPrefixOf` s)
898+
899+isUri :: String -> Bool
900+isUri s = let (scheme, path) = break (== ':') s
901+ in all (\c -> isAlphaNum c || c `elem` ".-") scheme
902+ && not (null path)
863903
864904isImageFilename :: String -> Bool
865905isImageFilename filename =
@@ -870,6 +910,33 @@ isImageFilename filename =
870910 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
871911 protocols = [ "file", "http", "https" ]
872912
913+-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with
914+-- @anchor-id@ set as id. Legal anchors in org-mode are defined through
915+-- @org-target-regexp@, which is fairly liberal. Since no link is created if
916+-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as
917+-- an anchor.
918+
919+anchor :: OrgParser (F Inlines)
920+anchor = try $ do
921+ anchorId <- parseAnchor
922+ recordAnchorId anchorId
923+ returnF $ B.spanWith (solidify anchorId, [], []) mempty
924+ where
925+ parseAnchor = string "<<"
926+ *> many1 (noneOf "\t\n\r<>\"' ")
927+ <* string ">>"
928+ <* skipSpaces
929+
930+-- | Replace every char but [a-zA-Z0-9_.-:] with a hypen '-'. This mirrors
931+-- the org function @org-export-solidify-link-text@.
932+
933+solidify :: String -> String
934+solidify = map replaceSpecialChar
935+ where replaceSpecialChar c
936+ | isAlphaNum c = c
937+ | c `elem` "_.-:" = c
938+ | otherwise = '-'
939+
873940emph :: OrgParser (F Inlines)
874941emph = fmap B.emph <$> emphasisBetween '/'
875942