From dbf4d77091f8bcde6d43f0945baf4905c18aebfc Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Thu, 18 Aug 2016 14:32:59 +0200
Subject: [PATCH] Org writer: ensure link targets are paths or URLs
Org-mode treats links as document internal searches unless the link
target looks like a URL or file path, either relative or absolute. This
change ensures that this is always the case.
---
src/Text/Pandoc/Writers/Org.hs | 28 +++++++++++++++++++++++-----
tests/writer.org | 4 ++--
2 files changed, 25 insertions(+), 7 deletions(-)
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 85b7433e6..431223f7d 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -39,8 +39,8 @@ import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Pretty
import Text.Pandoc.Templates (renderTemplate')
-import Data.Char ( toLower )
-import Data.List ( intersect, intersperse, partition, transpose )
+import Data.Char ( isAlphaNum, toLower )
+import Data.List ( isPrefixOf, intersect, intersperse, partition, transpose )
import Control.Monad.State
data WriterState =
@@ -354,16 +354,34 @@ inlineToOrg (Link _ txt (src, _)) = do
case txt of
[Str x] | escapeURI x == src -> -- autolink
do modify $ \s -> s{ stLinks = True }
- return $ "[[" <> text x <> "]]"
+ return $ "[[" <> text (orgPath x) <> "]]"
_ -> do contents <- inlineListToOrg txt
modify $ \s -> s{ stLinks = True }
- return $ "[[" <> text src <> "][" <> contents <> "]]"
+ return $ "[[" <> text (orgPath src) <> "][" <> contents <> "]]"
inlineToOrg (Image _ _ (source, _)) = do
modify $ \s -> s{ stImages = True }
- return $ "[[" <> text source <> "]]"
+ return $ "[[" <> text (orgPath source) <> "]]"
inlineToOrg (Note contents) = do
-- add to notes in state
notes <- get >>= (return . stNotes)
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ (length notes) + 1
return $ " [" <> text ref <> "]"
+
+orgPath :: String -> String
+orgPath src =
+ case src of
+ [] -> mempty -- wiki link
+ ('#':xs) -> xs -- internal link
+ _ | isUrl src -> src
+ _ | isFilePath src -> src
+ _ -> "file:" <> src
+ where
+ isFilePath :: String -> Bool
+ isFilePath cs = any (`isPrefixOf` cs) ["/", "./", "../", "file:"]
+
+ isUrl :: String -> Bool
+ isUrl cs =
+ let (scheme, path) = break (== ':') cs
+ in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme
+ && not (null path)
diff --git a/tests/writer.org b/tests/writer.org
index b29a1865c..6a86a4e3f 100644
--- a/tests/writer.org
+++ b/tests/writer.org
@@ -808,9 +808,9 @@ Auto-links should not occur here: =<http://example.com/>=
From "Voyage dans la Lune" by Georges Melies (1902):
#+CAPTION: lalune
-[[lalune.jpg]]
+[[file:lalune.jpg]]
-Here is a movie [[movie.jpg]] icon.
+Here is a movie [[file:movie.jpg]] icon.
--------------