@@ -79,6 +79,7 @@ type OrgBlockAttributes = M.Map String String
79-- | Org-mode parser state
79-- | Org-mode parser state
80data OrgParserState = OrgParserState
80data OrgParserState = OrgParserState
81 { orgStateOptions :: ReaderOptions
81 { orgStateOptions :: ReaderOptions
82+ , orgStateAnchorIds :: [String]
82 , orgStateBlockAttributes :: OrgBlockAttributes
83 , orgStateBlockAttributes :: OrgBlockAttributes
83 , orgStateEmphasisCharStack :: [Char]
84 , orgStateEmphasisCharStack :: [Char]
84 , orgStateEmphasisNewlines :: Maybe Int
85 , orgStateEmphasisNewlines :: Maybe Int
@@ -105,6 +106,7 @@ instance Default OrgParserState where
105defaultOrgParserState :: OrgParserState
106defaultOrgParserState :: OrgParserState
106defaultOrgParserState = OrgParserState
107defaultOrgParserState = OrgParserState
107 { orgStateOptions = def
108 { orgStateOptions = def
109+ , orgStateAnchorIds = []
108 , orgStateBlockAttributes = M.empty
110 , orgStateBlockAttributes = M.empty
109 , orgStateEmphasisCharStack = []
111 , orgStateEmphasisCharStack = []
110 , orgStateEmphasisNewlines = Nothing
112 , orgStateEmphasisNewlines = Nothing
@@ -116,6 +118,10 @@ defaultOrgParserState = OrgParserState
116 , orgStateNotes' = []
118 , orgStateNotes' = []
121+recordAnchorId :: String -> OrgParser ()
122+recordAnchorId i = updateState $ \s ->
123+ s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }
119addBlockAttribute :: String -> String -> OrgParser ()
125addBlockAttribute :: String -> String -> OrgParser ()
120addBlockAttribute key val = updateState $ \s ->
126addBlockAttribute key val = updateState $ \s ->
121 let attrs = orgStateBlockAttributes s
127 let attrs = orgStateBlockAttributes s
@@ -848,17 +854,14 @@ explicitOrImageLink = try $ do
848 title <- enclosedRaw (char '[') (char ']')
854 title <- enclosedRaw (char '[') (char ']')
849 title' <- parseFromString (mconcat <$> many inline) title
855 title' <- parseFromString (mconcat <$> many inline) title
851− return $ B.link src "" <$>
852− if isImageFilename src && isImageFilename title
857+ return $ if isImageFilename src && isImageFilename title
853− then return $ B.image title mempty mempty
858+ then pure $ B.link src "" $ B.image title mempty mempty
854− else title'
859+ else linkToInlinesF src =<< title'
856selflinkOrImage :: OrgParser (F Inlines)
861selflinkOrImage :: OrgParser (F Inlines)
857selflinkOrImage = try $ do
862selflinkOrImage = try $ do
858 src <- char '[' *> linkTarget <* char ']'
863 src <- char '[' *> linkTarget <* char ']'
859− returnF $ if isImageFilename src
860− then B.image src "" ""
861− else B.link src "" (B.str src)
864+ return $ linkToInlinesF src (B.str src)
863plainLink :: OrgParser (F Inlines)
866plainLink :: OrgParser (F Inlines)
864plainLink = try $ do
867plainLink = try $ do
@@ -878,6 +881,26 @@ selfTarget = try $ char '[' *> linkTarget <* char ']'
878linkTarget :: OrgParser String
881linkTarget :: OrgParser String
879linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")
882linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r[]")
884+linkToInlinesF :: String -> Inlines -> F Inlines
885+linkToInlinesF s@('#':_) = pure . B.link 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
893+ then pure $ B.link ('#':s) "" title
894+ else pure $ B.emph title
896+isRelativeUrl :: String -> Bool
897+isRelativeUrl s = (':' `notElem` s) && ("./" `isPrefixOf` s)
899+isUri :: String -> Bool
900+isUri s = let (scheme, path) = break (== ':') s
901+ in all (\c -> isAlphaNum c || c `elem` ".-") scheme
881isImageFilename :: String -> Bool
904isImageFilename :: String -> Bool
882isImageFilename filename =
905isImageFilename filename =
883 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
906 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
@@ -894,12 +917,15 @@ isImageFilename filename =
894-- an anchor.
917-- an anchor.
896anchor :: OrgParser (F Inlines)
919anchor :: OrgParser (F Inlines)
897−anchor = try $ pure <$> (B.spanWith <$> attributes <*> pure mempty)
920+anchor = try $ do
921+ anchorId <- parseAnchor
922+ recordAnchorId anchorId
923+ returnF $ B.spanWith (solidify anchorId, [], []) mempty
899− name = string "<<"
925+ parseAnchor = string "<<"
900− *> many1 (noneOf "\t\n\r<>\"' ")
926+ *> many1 (noneOf "\t\n\r<>\"' ")
901− <* string ">>"
927+ <* string ">>"
902− attributes = name >>= \n -> return (solidify n, [], [])
928+ <* skipSpaces
904-- | Replace every char but [a-zA-Z0-9_.-:] with a hypen '-'. This mirrors
930-- | Replace every char but [a-zA-Z0-9_.-:] with a hypen '-'. This mirrors
905-- the org function @org-export-solidify-link-text@.
931-- the org function @org-export-solidify-link-text@.